;------------------------------------------------------------------------------
; CFFA for Apple 1 firmware - CF Interface for Apple 1/Replica 1 computers
; CFFA1.s  Version 1.0 - 05/22/2007
;
; Firmware Contributors:        Email:
;   Dave Lyons                    dlyons@lyons42.com
;   Rich Dreher                   rich@dreher.net
;
; This firmware is designed to execute on an orginal 6502
;
; Tools used to build this firmware: CA65: 6502 Cross Assembler
;   http://www.cc65.org/
;
; Here is the copyright from that tool using --version option
; ca65 V2.11.0 - (C) Copyright 1998-2005 Ullrich von Bassewitz
;
; Example build instructions on an MSDOS based machine:
;------------------------------------------------------
; Assumes you have installed the CC65 package and set your path, etc.
;
; 1) ca65 --cpu 6502 -l CFFA1.s
; 2) ld65 -C CFFA1.cfg  CFFA1.o -o CFFA1.bin
;
; Firmware Version History
; ------------------------
;
; Version 1.0:
;  Based on spdv6502 firmware from CFFA project
;

; For testing on an Apple II, use "-D APPLE2=1".
; If the symbol is undefined, we set it to 0 here,
; to target the Apple 1.
   .ifndef APPLE2
APPLE2               =               0
   .endif

DEBUG                =               0

.define              EQU             =
.define              TRUE            1
.define              FALSE           0

SPACE                EQU             $A0
CR                   EQU             $8D
ESC                  EQU             $9B

CTRL                 EQU             $40

; Apple1 mainboard I/O address definitions

                     .if APPLE2
                     .else
KEY_CONTROL          EQU             $D011
KEY_DATA             EQU             $D010
DSP_DATA             EQU             $D012
DSP_CONTROL          EQU             $D013
APPLE1_MON           EQU             $FF1F
BASIC_WARM           EQU             $E2B3
                     .endif

StackBase            EQU             $100

;
; Firmware Version Information
;
FIRMWARE_VER         EQU             $01        ; Version of this code
OLDEST_COMPAT_VER    EQU             $01        ; oldest API version we are compatible with
BLOCKOFFSET          EQU               0        ; 0..255: LBA of first block of first partition
PARTITIONS32MB       EQU               4        ; Number of 32MB Partitions supported.

;------------------------------------------------------------------------------
; Slot I/O definitions
;
   .if APPLE2
   .else
IOBase              = $AFF0                     ; Address is set by the Slot select line T, which is typically wired to $A000 4K select line from 74154

SetCSMask           = IOBase+1                  ; Two special strobe locations to set and clear MASK bit that is used to disable CS0 line to
                                                ; the CompactFlash during the CPU read cycles
ClearCSMask         = IOBase+2                  ; that occur before every CPU write cycle. The normally innocuous read cycles were causing the SanDisk CF to double increment
                                                ; during sector writes commands.

ATADevCtrl          = IOBase+6                  ; When writing
ATAAltStatus        = IOBase+6                  ; When reading
ATAData             = IOBase+8
ATAError            = IOBase+9                  ; When reading
ATAFeature          = IOBase+9                  ; When writing
ATASectorCnt        = IOBase+10
ATA_LBA07_00        = IOBase+11
ATA_LBA15_08        = IOBase+12
ATA_LBA23_16        = IOBase+13
ATA_LBA27_24        = IOBase+14
ATACommand          = IOBase+15                 ; When writing
ATAStatus           = IOBase+15                 ; When reading
   .endif

;------------------------------------------------------------------------------
; Zero-page RAM memory usage
PCL                 = $3A
PCH                 = $3B

LOMEM               = $4A
HIMEM               = $4C

; ProDOS block interface locations
pdCommandCode       = $42
pdUnitNumber        = $43
pdIOBufferLow       = $44
pdIOBufferHigh      = $45
pdBlockNumberLow    = $46
pdBlockNumberHigh   = $47

   .if APPLE2
MiscZPStorage       = $00
   .else
MiscZPStorage       = $00  ; Currently approx 32 bytes used.
   .endif
;
; Inputs to the high-level routines (Rename, Delete, ReadFile, WriteFile, etc)
;
Destination         = MiscZPStorage         ; 2 bytes
Filename            = Destination+2         ; 2 bytes
OldFilename         = Filename+2            ; 2 bytes
Filetype            = OldFilename+2
Auxtype             = Filetype+1            ; 2 bytes
FileSize            = Auxtype+2             ; 2 bytes
EntryPtr            = FileSize+2            ; 2 bytes
;
; internal use
;
DirectoryBlock      = EntryPtr+2            ; 2 bytes - dir block # in Buffer
BitmapBase          = DirectoryBlock+2      ; 1 byte - low byte of block number (00..FF)
BitmapBlock         = BitmapBase+1          ; 1 byte - block currently in BitmapBuffer
BitmapDirty         = BitmapBlock+1
PastLastBitmapBlock = BitmapDirty+1         ; 1 byte - low byte of block number (00..FF)
TotalBlocks         = PastLastBitmapBlock+1 ; 2 bytes
UsedBlocks          = TotalBlocks+2         ; 2 bytes
FreeBlocks          = UsedBlocks+2          ; 2 bytes
EntryCounter        = FreeBlocks+2
BlockIndex          = EntryCounter+1        ; could easily move off of zero page
NameLen             = BlockIndex+1          ; could easily move off of zero page
LineCounter         = NameLen+1             ; could easily move off of zero page
digit_flag          = LineCounter+1         ; could easily move off of zero page
num                 = digit_flag+1          ; 2 bytes - could easily move off of zero page
;
LastMiscZPPlusOne   = num+2

zpt1                = $F0          ;data at this location is saved/restored
MsgPointerLow       = $F2
MsgPointerHi        = $F3

InputBuffer         = $0200
InputBuffer2        = $0280

;------------------------------------------------------------------------------
; ProDOS directory entry structure
;
oFiletype           = $10
oKeyBlock           = $11
oBlockCount         = $13
oFileSize           = $15
oCreateDateTime     = $18
oVersion            = $1C
oMinVersion         = $1D
oAccess             = $1E
oAuxtype            = $1F
oModDateTime        = $21
oHeaderPointer      = $25

kDirEntrySize       = $27
kEntriesPerBlock    = 13

oDirLinkPrevious    = $00
oDirLinkNext        = $02
oVolStorageType     = $04
oVolVersion         = $20
oVolAccess          = $22
oVolEntryLength     = $23
oVolEntriesPerBlock = $24
oVolFileCount       = $25
oVolBitmapNumber    = $27
oVolTotalBlocks     = $29

oSubdirParentPointer = $27
oSubdirParentEntryNum = $29
oSubdirParentEntryLength = $2A

kAccessDelete       = $80
kAccessRename       = $40
kAccessNeedsBackup  = $20
kAccessInvisible    = $04
kAccessWrite        = $02
kAccessRead         = $01
kAccessFull         = $C3

; Storage types
kSeedling           = $10
kSapling            = $20
kTree               = $30
kExtended           = $50
kDirectory          = $D0
kSubdirHeader       = $E0
kVolume             = $F0
kStorageTypeMask    = $F0

; Filetypes
kFiletypeText       = $04
kFiletypeBinary     = $06
kFiletypeDirectory  = $0F
kFiletypeBASIC1     = $F1
kFiletypeBAS        = $FC
kFiletypeSYS        = $FF

; other constants
kRootDirectoryBlock = 2
kCanonicalFirstBitmapBlock = 6

;------------------------------------------------------------------------------

CFFA1_Initialized   = $8700       ; $A5 = we've initialized our globals
CFFA1_Options       = $8701       ; bit 7 = logging, bit 6 = terse menu
SpecialFirstBlock   = $8702       ; 0 = normal, else high byte of special first-block buffer
DriveNumber         = $8703       ; normally 0 to 3 for four 32MB partitions
DrvBlkCount0        = $8705       ; low byte of usable block count
DrvBlkCount1        = $8706       ; bits 8..15 of usable block count
DrvBlkCount2        = $8707       ; bits 16..23 of usable block count

API_A                    = $8710
StopAfter256FreeBlocks   = $8711

FirstDirectoryBlock      = $87AD  ; 2 bytes - block # of first block of current directory
ForceRootDirectorySearch = $87AF  ; bit 7 = OpenDir on main directory, ignoring PrefixDirectory
PrefixDirectory          = $87B0  ; 16 bytes (length + up to 15 characters)

CopyOfZeroPage           = $87C0  ; copy of MiscZPStorage
   .if LastMiscZPPlusOne-MiscZPStorage > $40
   .error "MiscZPStorage too large for CopyOfZeroPage"
   .endif
StagingBuffer       = $8800
buffer              = $8A00
DirectoryBuffer     = $8C00
BitmapBuffer        = $8E00

;------------------------------------------------------------------------------
; Driver constant definitions
;
; ProDOS request Constants
PRODOS_STATUS       EQU             $00
PRODOS_READ         EQU             $01
PRODOS_WRITE        EQU             $02
PRODOS_FORMAT       EQU             $03

; ProDOS low-level return codes
PRODOS_NO_ERROR     EQU             $00    ; No error
PRODOS_BADCMD       EQU             $01    ; Bad Command (not implemented)
PRODOS_IO_ERROR     EQU             $27    ; I/O error
PRODOS_NO_DEVICE    EQU             $28    ; No Device Connected
PRODOS_WRITE_PROTECT EQU            $2B    ; Write Protected
PRODOS_BADBLOCK     EQU             $2D    ; Invalid block number requested
PRODOS_OFFLINE      EQU             $2F    ; Device off-line
; ProDOS high-level return codes
eBadPathSyntax      EQU             $40
eDirNotFound        EQU             $44
eFileNotFound       EQU             $46
eDuplicateFile      EQU             $47
eVolumeFull         EQU             $48
eDirectoryFull      EQU             $49
eFileFormat         EQU             $4A
eBadStrgType        EQU             $4B
eFileLocked         EQU             $4E
eNotProDOS          EQU             $52
eBadBufferAddr      EQU             $56
eBakedBitmap        EQU             $5A
eUnknownBASICFormat EQU             $FE
eUnimplemented      EQU             $FF

; ATA Commands Codes
ATACRead            EQU             $20
ATACWrite           EQU             $30
ATAIdentify         EQU             $EC
ATASetFeature       EQU             $EF
Enable8BitTransfers EQU             $01

; Constants for Wait
;   Constant = (Delay[in uS]/2.5 + 2.09)^.5 - 2.7
WAIT_100ms          EQU             197
WAIT_40ms           EQU             124
WAIT_100us          EQU             4

.listbytes      unlimited 

;------------------------------------------------------------------------------
; CFFA1 firmware entry jump table
;
 .if APPLE2
Origin = $0A00                  ; CALL 2560
 .else
Origin = $9000                  ; CALL -28672
 .endif
   .ORG    Origin
    
   jmp     MenuExitToMonitor    ; $9000
   jmp     MenuExitToBASIC      ; $9003
   jmp     Menu                 ; $9006
   jmp     CFBlockDriver        ; $9009
   jmp     CFFA1_API            ; $900C
; add jumps to new functionallity here....
   nop
   nop
   nop
   nop
   nop
   nop

;------------------------------------------------------------------------------
; CFFA1_API -- Entry point for assembly programs to call CFFA1 ROM.
;
;    ldx #Command
;    jsr API
;
; Result:  CLC, A = 0 for success
;          SEC, A = error code
CFFA1_API:
   cpx #dispatchAPI_end-dispatchAPI
   bcs @badCommand
   sta API_A
   jsr InitializeGlobals
   jsr @DispatchAPI
   bcs @exit
   lda #0
   rts

@DispatchAPI:
   lda dispatchAPI+1,x
   pha
   lda dispatchAPI,x
   pha
   lda API_A
   rts

@badCommand:
   lda #PRODOS_BADCMD
   sec
@exit:
   rts

;
; These API_* routines return with SEC/A=error, or with CLC (A=anything).
; The dispatcher takes care of setting A=0 in the no-error case.
;
dispatchAPI:
   .word API_Version-1             ; $00
   .word API_Menu-1                ; $02
   .word API_DisplayError-1        ; $04
   .word API_Reserved-1            ; $06
   .word API_Reserved-1            ; $08
   .word API_Reserved-1            ; $0A
   .word API_Reserved-1            ; $0C
   .word API_Reserved-1            ; $0E

   .word API_OpenDir-1             ; $10
   .word API_ReadDir-1             ; $12
   .word API_FindDirEntry-1        ; $14
   .word API_Reserved-1            ; $16
   .word API_Reserved-1            ; $18
   .word API_Reserved-1            ; $1A
   .word API_Reserved-1            ; $1C
   .word API_Reserved-1            ; $1E

   .word API_WriteFile-1           ; $20
   .word API_ReadFile-1            ; $22
   .word API_SaveBASICFile-1       ; $24
   .word API_LoadBASICFile-1       ; $26
   .word API_Rename-1              ; $28
   .word API_Delete-1              ; $2A
   .word API_NewDirectoryAtRoot-1  ; $2C
   .word API_FormatDrive-1         ; $2E
dispatchAPI_end:

API_Reserved:
   lda #eUnimplemented
   sec
   rts

API_Version:
   ldx #FIRMWARE_VER
   ldy #OLDEST_COMPAT_VER
   clc
   rts

API_Menu:
   jsr Menu
   clc
   rts

API_DisplayError:
   jsr DisplayError
   clc
   rts

API_FormatDrive:
   cpy #$77          ; extra magic number to avoid accidental formatting
   bne @fail
   jmp FormatDrive
@fail:
   lda #PRODOS_BADCMD
   sec
   rts

;------------------------------------------------------------------------------
; InitializeGlobals
;
; Preserves:  X, Y.
;
InitializeGlobals:
   lda #$A5
   cmp CFFA1_Initialized
   beq @initialized
   sta CFFA1_Initialized
;
; Set up additional globals here.
;
   lda #0
   sta CFFA1_Options
   sta DriveNumber
   sta PrefixDirectory            ;empty prefix = use root of volume
   sta ForceRootDirectorySearch
@initialized:
   rts

;------------------------------------------------------------------------------
;
; Set up break handler vector for Apple1 ROM vector at: $100
;
SetUpBreakHandler:
 .if APPLE2
 .else
   lda   #$4C
   sta   $100
   lda   #<BreakHandler
   sta   $101
   lda   #>BreakHandler
   sta   $102
 .endif
   rts

;------------------------------------------------------------------------------
;
; Break/IRQ handler
;
 .if APPLE2
 .else
BreakHandler:
         pla
         pha              ;**irq handler
         asl
         asl
         asl
         bmi   @Break      ;test for break

@IRQ:
         jsr   DispString
         .byte "IRQ...",CR,CR,0
         jmp   APPLE1_MON

@Break:
         jsr   DispString
         .byte "BREAK...",CR,CR,0
         jmp   APPLE1_MON
 .endif

;------------------------------------------------------------------------------
;
; Run the menu, and then exit to the monitor.
;
MenuExitToMonitor:
   jsr     Menu
 .if APPLE2
   jmp     $FF69        ; Apple II monitor
 .else
   jmp     APPLE1_MON
 .endif

;------------------------------------------------------------------------------
;
; Run the menu, and then exit to BASIC.
;
MenuExitToBASIC:
   jsr     Menu
 .if APPLE2
   jmp     $E003
 .else
   jmp     BASIC_WARM
 .endif


;------------------------------------------------------------------------------
; CFFA1 interactive menu
;
Menu:
   jsr     SaveZeroPage
   jsr     InitializeGlobals
   jsr     SetUpBreakHandler
MenuAgain:
   jsr     DisplayMenu
   jsr     WaitForKey              ; wait for user to press any key
   jsr     DispChar                ; display char user typed
   jsr     DispString
   .byte   CR,CR,0

   and     #$7F                    ; strip high bit before comparison
   jsr     UppercaseA
   ldx     #-4
@FindMenuItem:
   inx
   inx
   inx
   inx
   ldy     MenuChoices,x
   beq     UnknownMenuChoice
   cmp     MenuChoices,x
   bne     @FindMenuItem

   lda     MenuChoices+3,x
   sta     Destination+1
   lda     MenuChoices+2,x
   sta     Destination
   jsr     @DoMenuChoice
   jmp     MenuAgain

@DoMenuChoice:
   jmp     (Destination)

UnknownMenuChoice:
   jsr     DispString
   .byte "?",CR,0
   bit     CFFA1_Options
   bvc     @1
   jsr     DisplayOptions          ; in Terse mode, display options after invalid choice
@1:
   jmp     MenuAgain

MenuExit:
   pla                             ; discard the DoMenuChoice return address
   pla
;  v v v  Fall into  v v v
;------------------------------------------------------------------------------
; RestoreZeroPage
;
RestoreZeroPage:
   ldx #LastMiscZPPlusOne-MiscZPStorage-1
@restore:
   lda CopyOfZeroPage,x
   sta MiscZPStorage,x
   dex
   bpl @restore
   rts

;------------------------------------------------------------------------------
; SaveZeroPage
;
SaveZeroPage:
   ldx #LastMiscZPPlusOne-MiscZPStorage-1
@save:
   lda MiscZPStorage,x
   sta CopyOfZeroPage,x
   dex
   bpl @save
   rts

;------------------------------------------------------------------------------
DisplayMenu:
   bit CFFA1_Options
   bvs @terse
   jsr DisplayOptions
@terse:
   jsr DispString
   .byte CR,"CFFA1> ",0
   rts

DisplayOptions:
   jsr DispString
   .byte CR, " CFFA1 MENU (1.0)",CR
   .byte     " ----------",CR
   .byte " C - CATALOG      P - PREFIX",CR
   .byte " L - LOAD         N - NEW DIRECTORY",CR
   .byte " S - SAVE (BASIC) W - WRITE FILE",CR
   .byte " R - RENAME       D - DELETE",CR
   .byte "^F - FORMAT       T - TERSE",CR
   .byte " B - READ BLOCK   M - MEMORY DISPLAY",CR
;  .byte "^S - STATUS      ^D - DEBUG",CR
   .byte " Q - QUIT",CR,0
   rts

MenuChoices:
   .word 'C', MenuCatalog
   .word 'P', MenuPrefix
   .word 'L', MenuLoadBASICOrBinaryFile
   .word 'N', MenuNewDirectory
   .word 'S', MenuSaveBASICFile
   .word 'W', MenuWriteFile
   .word 'R', MenuRenameFile
   .word 'D', MenuDeleteFile
   .word 'F'-CTRL, MenuFormat
   .word 'T', MenuToggleTerse
   .word 'B', MenuReadBlock
   .word 'M', MenuDisplayMemory
   .word 'D'-CTRL, MenuToggleDebug
   .word 'S'-CTRL, MenuGetStatus
   .word 'Q', MenuExit
 .if DEBUG
   .word 'Z'-CTRL, MenuWriteTwelveFiles
 .endif
   .word '?', DisplayOptions
   .word 0

;------------------------------------------------------------------------------
; MenuReadBlock
;
MenuReadBlock:
   jsr DispString
   .byte "READ BLOCK: $",0
   jsr InputNumberAX
   bcc @notEmpty
   rts
@notEmpty:
   jsr UseBuffer
   jsr ReadBlockAX
   bcs @err
   lda #>buffer
   ldx #<buffer
   sta Destination+1
   stx Destination
   lda #>512
   ldx #<512
   sta FileSize+1
   stx FileSize
   jmp DisplayMemory
@err:
   jmp DisplayError

;------------------------------------------------------------------------------
; MenuDisplayMemory
;
MenuDisplayMemory:
   jsr DispString
   .byte "START: $",0
   jsr InputNumberAX
   bcs @exit
   sta Destination+1
   stx Destination

   jsr DispString
   .byte "  END: $",0
   jsr InputNumberAX
   bcc @go
@exit:
   rts
@go:
   tay                ; compute FileSize = (AX - Destination) + 1
   txa
   sec
   sbc Destination
   tax
   tya
   sbc Destination+1
   tay
   inx
   bne @1
   iny
@1:
   stx FileSize
   sty FileSize+1
; v v v   fall into   v v v
;------------------------------------------------------------------------------
; DisplayMemory
;
; Input:  Destination (starting address), FileSize (number of bytes to display)
;
DisplayMemory:
   jsr ResetLineCount

   lda FileSize
   bne @noBorrow
   dec FileSize+1
@noBorrow:
   dec FileSize

@line:
   jsr DisplayOneLine
   bcs @exit
   lda FileSize
   sbc #7            ; subtracts 8, since carry is clear
   sta FileSize
   lda FileSize+1
   sbc #0
   sta FileSize+1
   bcs @line
@exit:
   jmp PressSpaceAndDispCR   ;SEC if we have already had ESC=abort

DisplayOneLine:
   lda Destination+1
   jsr DispByte
   lda Destination
   jsr DispByte
   lda #':'+$80
   jsr DispChar
   ldy #0
@byte:
   lda (Destination),y
   jsr DispByte
   jsr DispSpace
   iny
   cpy #8
   bcc @byte

   jsr DispSpace
   ldy #0
@char:
   lda (Destination),y
   jsr DisplayCharPrintable
   iny
   cpy #8
   bcc @char

   tya
   clc
   adc Destination
   sta Destination
   bcc @samePage
   inc Destination+1
@samePage:
   jmp PauseEveryNLines

DisplayCharPrintable:
   ora #$80
   cmp #SPACE
   bcs @ok
   lda #'.'+$80
@ok:
   jmp DispChar


;------------------------------------------------------------------------------
; MenuGetStatus
;
; Prompt for drive number, call Status, and display the block count.
;
MenuGetStatus:
   jsr DispString
   .byte "DRIVE # (0-3): $",0
   jsr InputNumberAX
   bcs @exit
   stx DriveNumber

   jsr DispString
   .byte "BLOCK COUNT FOR DRIVE ",0
   lda DriveNumber
   ora #'0'
   jsr DispChar

   lda #PRODOS_STATUS
   sta pdCommandCode
   jsr CFBlockDriver
   bcs @error

   jsr DispString
   .byte " = ",0
   tya
   jsr DispByteWithDollarSign
   txa
   jsr DispByte
   jsr DispCR

@exit:
   rts

@error:
   jsr DispString
   .byte CR,0
   jmp DisplayError

;------------------------------------------------------------------------------
; MenuLoadBASICOrBinaryFile
;
MenuLoadBASICOrBinaryFile:
   jsr DispString
   .byte "   LOAD FILE: ",0
   jsr GETLN
   beq @empty

   ldx #127
@copyName:
   lda InputBuffer,x
   sta InputBuffer2,x
   dex
   bpl @copyName

   lda #>InputBuffer2
   ldx #<InputBuffer2
   sta Filename+1
   stx Filename
   jsr GetFileInfo
   bcs @showError

; Is it a BASIC file?
   lda Filetype
   cmp #$F1
   beq @loadBASIC

; for any other file, prompt for load address (defaulting to file's Auxtype)
   jsr DispString
   .byte "ADDR (",0
   lda Auxtype+1
   ldx Auxtype
   jsr PrintHexAX
   jsr DispString
   .byte "): ",0
   jsr InputNumberAX
   beq @default
   bcc @addrSupplied
@error:
@empty:
   rts

@default:
   lda #0
   tax
@addrSupplied:
   jsr ReadFileAtAX
@showError:
   jmp DisplayError

@loadBASIC:
   jsr LoadBASICFile
   jmp DisplayError


 .if DEBUG
;------------------------------------------------------------------------------
; MenuWriteTwelveFiles
;
MenuWriteTwelveFiles:

   lda #>InputBuffer
   ldx #<InputBuffer
   sta Filename+1
   stx Filename

   lda #1
   sta InputBuffer
   lda #'A'
   sta InputBuffer+1

@nextFile:
   lda #>$1000
   ldx #<$1000
   sta Destination+1
   stx Destination
   sta Auxtype+1
   stx Auxtype

   lda #>$1234
   ldx #<$1234
   sta FileSize+1
   stx FileSize

   lda #kFiletypeBinary
   sta Filetype

   jsr WriteFile
   bcs @error

   jsr DispString
   .byte "Wrote file ",0
   lda InputBuffer+1
   jsr DispChar
   jsr DispCR

   inc InputBuffer+1
   lda InputBuffer+1
   cmp #'M'
   bcc @nextFile
   rts

@error:
   jmp DisplayError
 .endif

;------------------------------------------------------------------------------
; MenuWriteFile
;
MenuWriteFile:
   jsr DispString
   .byte "WRITE FROM: $",0
   jsr InputNumberAX
   bcs @empty
   sta Destination+1
   stx Destination
   sta Auxtype+1
   stx Auxtype

   jsr DispString
   .byte "    LENGTH: $",0
   jsr InputNumberAX
   bcs @empty
   sta FileSize+1
   stx FileSize

; Prompt for filetype
   jsr DispString
   .byte "TYPE (BIN): $",0
   lda #kFiletypeBinary
   sta Filetype
   jsr InputNumberAX
   beq @defaultFiletype
   bcs @error
   stx Filetype
@defaultFiletype:

   jsr DispString
   .byte "      NAME: ",0
   jsr GetFilename
   beq @empty

   jsr WriteFile
   jsr DisplayError

@empty:
@error:
   rts

;------------------------------------------------------------------------------
; MenuNewDirectory
;
MenuNewDirectory:
   jsr DispString
   .byte "NEW DIRECTORY: ",0
   jsr GetFilename
   beq @empty

   jsr NewDirectoryAtRoot
   jsr DisplayError
@empty:
   rts

;------------------------------------------------------------------------------
; MenuPrefix
;
MenuPrefix:
   jsr DispString
   .byte "PREFIX DIR: ",0
   jsr GetFilename
   jsr SetPrefix
   jsr DisplayError
   rts

;------------------------------------------------------------------------------
; MenuDeleteFile
;
MenuDeleteFile:
   jsr DispString
   .byte "DELETE: ",0
   jsr GetFilename
   beq @empty

   jsr Delete
   jsr DisplayError
@empty:
   rts


;------------------------------------------------------------------------------
; MenuRenameFile
;
MenuRenameFile:
   jsr DispString
   .byte "RENAME: ",0
   jsr GetFilename
   beq @empty

   ldx #15
@copyOrigName:
   lda InputBuffer,x
   sta InputBuffer2,x
   dex
   bpl @copyOrigName

   jsr DispString
   .byte "    TO: ",0
   jsr GetFilename
   beq @empty

; rename from InputBuffer2 to InputBuffer
   lda #>InputBuffer2
   ldx #<InputBuffer2
   sta OldFilename+1
   stx OldFilename
   jsr Rename
   jsr DisplayError
@empty:
   rts


;------------------------------------------------------------------------------
; MenuToggleDebug - turn logging on/off
; MenuToggleTerse - turn the menu on/off
;
MenuToggleDebug:
   jsr DispString
   .byte "DEBUG",0
   lda #$80
   bne toggleOptions
MenuToggleTerse:
   jsr DispString
   .byte "TERSE",0
   lda #$40
toggleOptions:
   pha
   eor CFFA1_Options   ; toggle the selected option
   sta CFFA1_Options
   pla
   and CFFA1_Options   ; check whether the toggled option is on or off
   beq @off
   jsr DispString
   .byte " ON",CR,0
   rts
@off:
   jsr DispString
   .byte " OFF",CR,0
   rts

;------------------------------------------------------------------------------
; MenuFormat
;
MenuFormat:
   jsr DispString
   .byte "DESTROY DATA ON DRIVE ",0
   lda DriveNumber
   ora #'0'
   jsr DispChar
   jsr DispString
   .byte CR,CR,0

; If we're about to overwrite a ProDOS disk, present the name and the blocks-used
; to make sure the user knows what they're overwriting.
   jsr ComputeBlockCounts
   bcs @notProDOS

   jsr DispString
   .byte "DESTROY ",0
   jsr DisplayVolumeName

   jsr DispString
   .byte CR,"   BLOCKS USED: ",0
   lda UsedBlocks+1
   ldx UsedBlocks
   jsr PrintDecimalAX
   jsr DispString
   .byte CR,CR,0
@notProDOS:

; Make sure they really want to erase.  Make them type YES Return.
   jsr DispString
   .byte "ARE YOU SURE? ('YES') ",0
   jsr GETLN
   beq @exit
   ldy #3
@checkYES:
   lda InputBuffer,y
   cmp @YES,Y
   bne @aborted
   dey
   bpl @checkYES

; Prompt for the new volume name and validate it.
   jsr DispString
   .byte CR,"VOLUME NAME: ",0
   jsr GetFilename
   beq @aborted
   jsr FormatDrive
   jmp DisplayError

@aborted:
   jsr DispString
   .byte "ABORTED",CR,0
@exit:
   rts

@YES:
   .byte 3,"YES"

;------------------------------------------------------------------------------
MenuSaveBASICFile:
   jsr DispString
   .byte "SAVE: ",0
   jsr GetFilename
   beq @empty
   jsr SaveBASICFile
   jmp DisplayError
@empty:
   rts

;------------------------------------------------------------------------------
; InputNumberAX
;
; Result: 
;         BEQ if the user didn't enter anything at all
;
;         SEC if the user didn't enter a good number
;         CLC, AX = number
;
; Destroys InputBuffer.
;
InputNumberAX:
   jsr GETLN
   bne @notEmpty
   sec
   rts
@notEmpty:

; parse the number (1 to 4 digits in hex)
   cmp #5
   bcs @exitNotEmpty

   ldy #0
   sty num+1
   sty num
@char:
   lda InputBuffer+1,y
   jsr AccumulateHexDigit
   bcs @exitNotEmpty
   iny
   cpy InputBuffer
   bcc @char
   lda num+1
   ldx num
   clc
@exitNotEmpty:
   ldy #1          ; BNE (not empty)
   rts

;
; AccumulateHexDigit - Adds value of character A to Number.
;
; Result: CLC for success (Number adjusted)
;         SEC for error (not a hex character)
;
; Preserves Y.
;
AccumulateHexDigit:
   ldx #4
@shift:
   asl num
   rol num+1
   dex
   bne @shift
   jsr UppercaseA
   cmp #'F'+1
   bcs @digit_bad
   cmp #'A'
   bcs @hexLetter
   cmp #'9'+1
   bcs @digit_bad
   cmp #'0'
   bcc @digit_bad
   and #$0F
   bpl @addNumber   ; always taken
@hexLetter:
   sec
   sbc #'A'-10
@addNumber:
   clc
   adc num
   sta num
;  clc
   rts

@digit_bad:
   sec
   rts

UppercaseA:
   cmp #'z'+1
   bcs @done
   cmp #'a'
   bcc @done
   and #%11011111
@done:
   rts

;------------------------------------------------------------------------------
; DispString - Sends a String to the Apple1's console
; Input:
;       string must immediately follow the JSR to this function
;       and be terminated with zero byte.
; Ouput:
;       None
;
; ZeroPage Usage:
;       MsgPointerLow, MsgPointerHi   (saved and restored)
;
; CPU Registers changed:  P
;
; Someday: Try compressing text by allowing $Fx = a run of blanks, $Ex = a run
; of hyphens, and various other bytes to stand for commonly-used strings,
; such as " BASIC ", "FILE", "BLOCK", "READ", "FROM", "NAME", " FULL", "BAD ".
;
DispString:
   pha                          ;save the Acc reg
   txa
   pha                          ;save the X reg
   tya
   pha                          ;save the Y reg
 .if APPLE2
   jsr $fe89
   jsr $fe93  ; disconnect BASIC.SYSTEM (which uses lots of zero page) from COUT and KEYIN
 .endif
   tsx                          ;put the stack pointer in X
   lda  MsgPointerHi
   pha                          ;push zero page location on stack
   lda  MsgPointerLow
   pha                          ;push zero page location on stack

   lda  StackBase+4,x           ;determine the location of message to display
   clc
   adc  #$01                    ;add 1 because JSR pushes the last byte of its
   sta  MsgPointerLow           ; destination address on the stack

   lda  StackBase+5,x
   adc  #0
   sta  MsgPointerHi

@dss1:
   ldy  #0
   lda  (MsgPointerLow),y
   beq  @dssend
   jsr  DispChar                  ;display message
   inc  MsgPointerLow
   bne  @dss1
   inc  MsgPointerHi
   bne  @dss1

@dssend:

   lda  MsgPointerHi
   sta  StackBase+5,x
   lda  MsgPointerLow
   sta  StackBase+4,x           ;fix up the return address on the stack.

   pla
   sta  MsgPointerLow           ;restore zero page location
   pla
   sta  MsgPointerHi            ;restore zero page location
   pla
   tay
   pla
   tax
   pla
   rts                          ;return to location after string's null.


;------------------------------------------------------------------------------
; PrintDecimalAX
;
; Print a 16-bit unsigned number in decimal ("0" to "65535")
;
PrintDecimalAX:
   lsr digit_flag
   sta num+1
   stx num

   ldy #4
@prd_l1:
   ldx #$80+'0'	;Digit so far
@prd_l2:
   lda num+1
   cmp @hi10,y
   bne @pcmp_done
   lda num
   cmp @low10,y
@pcmp_done:
   bcc @pr_digit
;  sec
   lda num
   sbc @low10,y
   sta num
   lda num+1
   sbc @hi10,y
   sta num+1
   inx
   bne @prd_l2
@pr_digit:
   cpy #0
   beq @printit
   cpx #$80+'0'
   bne @printit
   bit digit_flag
   bpl @printed
@printit:
   sec
   ror digit_flag
@printit2:
   txa
   jsr DispChar
@printed:
   dey
   bpl @prd_l1
   rts

@low10:  .byte $01,$0a,$64,$e8,$10
@hi10:   .byte $00,$00,$00,$03,$27

;------------------------------------------------------------------------------
; DisplayError
;
; Input: A
;
; Displays (CR) "xx [description]"
;
DisplayError:
   jsr DispString
   .byte CR,0

   pha
   jsr DispByte
   pla

   ldx #lastError-errorNumbers
@search:
   cmp errorNumbers,x
   beq @errFound
   dex
   dex
   bpl @search
   jmp DispCR

@errFound:
   lda errorNumbers+1,x
   tax
   jsr DispSpace
   lda sErrorStrings,x
@char:
   jsr DispChar
   inx
   lda sErrorStrings,x
   bne @char
   jmp DispCR

errorNumbers:
   .byte PRODOS_IO_ERROR, sIOError-sErrorStrings
   .byte PRODOS_OFFLINE, sOffline-sErrorStrings
   .byte eBadPathSyntax, sBadPathSyntax-sErrorStrings
   .byte eFileNotFound, sFileNotFound-sErrorStrings
   .byte eDuplicateFile, sDuplicateFile-sErrorStrings
   .byte eVolumeFull, sVolumeFull-sErrorStrings
   .byte eDirectoryFull, sDirectoryFull-sErrorStrings
   .byte eBadStrgType, sBadStrgType-sErrorStrings
   .byte eFileLocked, sFileLocked-sErrorStrings
   .byte eNotProDOS, sNotProDOS-sErrorStrings
   .byte eBadBufferAddr, sBadBuffer-sErrorStrings
   .byte eBakedBitmap, sBakedBitmap-sErrorStrings
   .byte eUnknownBASICFormat, sUnknownBASICFormat-sErrorStrings
   .byte eUnimplemented, sUnimplemented-sErrorStrings
lastError:
   .byte 0, sSuccess-sErrorStrings

sErrorStrings:
sIOError:
   .byte "I/O ERROR",0
sOffline:
   .byte "OFFLINE",0
sBadPathSyntax:
   .byte "BAD NAME",0
sFileNotFound:
   .byte "FILE NOT FOUND",0
sDuplicateFile:
   .byte "DUPLICATE FILE",0
sVolumeFull:
   .byte "DISK FULL",0
sDirectoryFull:
   .byte "DIRECTORY FULL",0
sBadStrgType:
   .byte "BAD STORAGE TYPE",0
sFileLocked:
   .byte "LOCKED",0
sNotProDOS:
   .byte "NOT PRODOS DISK",0
sBadBuffer:
   .byte "BAD BUFF ADDRESS",0
sBakedBitmap:
   .byte "BAKED BITMAP",0
sUnknownBASICFormat:
   .byte "NOT A BASIC FILE",0
sUnimplemented:
   .byte "WRITE MORE CODE", 0
sSuccess:
   .byte "SUCCESS",0
sPastStringTable:
  .if sPastStringTable-sErrorStrings > 255
  .error "ERROR MESSAGE TABLE TOO LARGE"
  .endif

;------------------------------------------------------------------------------
; DispByte - Sends a Hex byte to the console
; Input:
;       A = Hex number to display
; Ouput:
;       None
;
; CPU Registers changed:  A, P
;
DispByteWithDollarSign:
   jsr DispString
   .byte "$",0
DispByte:
   pha
   lsr a
   lsr a
   lsr a
   lsr a
   jsr Nibble
   pla
Nibble:
   and #$0F
   ora #'0'
   cmp #'0'+10
   bcc @digit
   adc #6
@digit:
   bne DispChar   ; always taken

;------------------------------------------------------------------------------
; DispCR, DispSpace, and DispChar - Sends a char to the Apple1 console
;
; Input:
;       A = Character to Send
; Ouput:
;
; ZeroPage Usage:
;       None
;
; CPU Registers changed:  Acc, P
;
; X and Y are preserved.
;
DispSpace:
   lda #SPACE
   bne DispChar
PressSpaceAndDispCR:
   bcs DispCR              ; already hit ESC to abort
   jsr PressSpaceOrESC
DispCR:
   lda #CR
DispChar:
 .if APPLE2
   ora      #$80
   stx      xsave
   sty      ysave
   jsr      $fded
   ldx      xsave
   ldy      ysave
   rts
xsave:
   .byte 0
ysave:
   .byte 0
 .else
; Wait until display is ready
   bit      DSP_DATA
   bmi      DispChar
; Send character to display hardware
   sta      DSP_DATA
   rts
 .endif

;------------------------------------------------------------------------------
; WaitForKey - Wait until a key is pressed. Returns key stroke in Acc
; Input:
;      None
; Ouput:
;      Acc = ASCII value of key pressed
;
; X and Y are preserved.
;
WaitForKey:
 .if APPLE2
    stx wfk_xsave
    sty wfk_ysave
    jsr $fd0c
    ldx wfk_xsave
    ldy wfk_ysave
    rts
wfk_xsave:
    .byte 0
wfk_ysave:
    .byte 0
 .else
    lda     KEY_CONTROL
    bpl     WaitForKey
    lda     KEY_DATA
    rts
 .endif

;------------------------------------------------------------------------------
; GetFilename
;
; Result: Sets Filename = InputBuffer and calls GETLN.
;         BEQ for an empty input
;
GetFilename:
   lda #>InputBuffer
   ldx #<InputBuffer
   sta Filename+1
   stx Filename
;  v v v   FALL INTO   v v v
;------------------------------------------------------------------------------
; GETLN
;
; Read a string from the keyboard.
;
; Result:  InputBuffer (byte) = length of string
;          InputBuffer+1 = characters (high bit clear, terminated by a $00)
;          A = length
;          BEQ = empty string
;
GETLN:
   ldy #0
getln1:
   jsr WaitForKey
   cmp #CR
   beq getln_done
   cmp #ESC
   beq getln_esc
   cmp #$98              ; Ctrl-X cancel
   beq getln_esc
   cmp #'_'+$80          ; Underscore = backspace
   beq getln_backspace
   cmp #$88              ; Ctrl-H backspace
   beq getln_backspace
   cmp #$FF              ; Delete/Rubout
   beq getln_backspace0
   jsr DispChar
   and #$7f
   sta InputBuffer+1,y
   iny
   bpl getln1
getln_esc:
   jsr DispString
   .byte '\',CR,0
   jmp GETLN

getln_backspace0:
   lda #$88              ; print a Ctrl-H
getln_backspace:
   cpy #0
   beq getln_esc
   jsr DispChar
   dey
   jmp getln1

getln_done:
   lda #0
   sta InputBuffer+1,y
   sty InputBuffer
   jsr DispCR
   tya
   rts


;--------------------------------------------------------------------------------------------------
;--------------------------------------------------------------------------------------------------
;--------------------------------------------------------------------------------------------------
;--------------------------------------------------------------------------------------------------


;--------------------------------------------------------------------------------------------------
;
; Catalog
;
;  FILENAME        TYPE/AUX   BLOCKS
;  --------------- ---------  ------
; *FILENAME1234567 $TYP/$AUXT 12345 
;
; (The "*" marks Locked items.)
;
MenuCatalog:
   jsr ResetLineCount
   jsr OpenRootDir
   bcs @CatError

   jsr DisplayVolumeName
   jsr DisplayPrefixDirectory
   jsr PauseEveryNLines
   jsr DisplayCatalogHeader

; If there is a Prefix, call OpenDir (replacing our call to OpenRootDir above)
   lda PrefixDirectory
   beq @root
   jsr OpenDir
   bcs @CatError
@root:

@Cat1:
   jsr ReadDir
   bcs @CatDone
   jsr CatLockedOrUnlocked
   jsr CatFilename
   jsr CatFiletype
   lda #'/'
   jsr DispChar
   jsr CatAuxtype
   jsr DispString
   .byte "  ",0
   jsr CatBlockCount
   jsr PauseEveryNLines
   bcc @Cat1
   rts

@CatError:
   jmp DisplayError

; Show the block counts:
;    BLKS FREE:nnnnn USED:nnnnn TOTAL:nnnnn
@CatDone:
   cmp #eFileNotFound
   bne @CatError
   jsr ComputeBlockCounts
   bcs @CatError

   jsr PauseEveryNLines
   bcc @1
   rts
@1:
   jsr DispString
   .byte "BLKS FREE:",0
   lda FreeBlocks+1
   ldx FreeBlocks
   jsr PrintDecimalAX

   jsr DispString
   .byte " USED:",0
   lda UsedBlocks+1
   ldx UsedBlocks
   jsr PrintDecimalAX

   jsr DispString
   .byte " TOTAL:",0
   lda TotalBlocks+1
   ldx TotalBlocks
   jsr PrintDecimalAX
   jsr DispCR
   clc
   jmp PressSpaceAndDispCR

DisplayCatalogHeader:
   jsr DispString
   .byte CR
   .byte " FILENAME        TYPE/AUX   BLOCKS",CR
   .byte " --------------- ---------  ------",0
   jmp PauseEveryNLines

;
; Display a "*" for Locked or a blank for unlocked.
;
CatLockedOrUnlocked:
   ldy #oAccess
   lda (EntryPtr),y
   and #kAccessFull
   cmp #kAccessFull
   beq unlocked
   lda #'*'
   jmp DispChar
unlocked:
   jmp DispSpace

;
; Display a filename (with trailing blanks)
;
CatFilename:
   ldy #0
   lda (EntryPtr),y
   and #$0f
   tay
   iny
   sty NameLen
   ldy #1
@char:
   lda (EntryPtr),y
   ora #$80
   jsr DispChar
   iny
   cpy NameLen
   bcc @char
@blanks:
   lda #' '
   jsr DispChar
   iny
   cpy #17
   bcc @blanks
   rts

;
; Display a filetype (three-letter abbreviation or $xx)
;
CatFiletype:
   ldy #oFiletype
   lda (EntryPtr),y
   ldx #-4
@findFiletype:
   inx
   inx
   inx
   inx
   ldy filetypeNames,x
   beq @filetypeHex
   cmp filetypeNames,x
   bne @findFiletype

   ldy #3
@loop:
   lda filetypeNames+1,x
   jsr DispChar
   inx
   dey
   bne @loop
   rts

@filetypeHex:
   jmp DispByteWithDollarSign

filetypeNames:
   .byte $04,'T','X','T'
   .byte $06,'B','I','N'
   .byte $0F,'D','I','R'
   .byte $F1,'B','A','1' ; "BA1" for Apple 1 BASIC
   .byte $FC,'B','A','S'
   .byte $FF,'S','Y','S'
   .byte 0

;
; Display the block count (decimal, 0 to 65535)
;
CatBlockCount:
   ldy #oBlockCount
CatDecimalWord:
   lda (EntryPtr),y
   tax
   iny
   lda (EntryPtr),y
   jmp PrintDecimalAX

;
; Display the auxtype ($xxxx)
;
CatAuxtype:
   ldy #oAuxtype
CatHexWord:
   lda (EntryPtr),y
   tax
   iny
   lda (EntryPtr),y
PrintHexAX:
   jsr DispByteWithDollarSign
   txa
   jmp DispByte

;------------------------------------------------------------------------------
; DisplayVolumeName
;
; Print "VOLUME: " and the name of the volume whose root directory block has
; been read into DirectoryBuffer.
;
; Destroys: A, X, Y.
;
DisplayVolumeName:
   jsr DispString
   .byte "VOLUME: ",0
   lda DirectoryBuffer+oVolStorageType
   and #$0f
   tax
   ldy #1
@volName:
   lda DirectoryBuffer+oVolStorageType,y
   jsr DispChar
   iny
   dex
   bne @volName
   rts

;------------------------------------------------------------------------------
; DisplayPrefixDirectory
;
; Print "  DIR: " and the PrefixDirectory
;
; Destroys: A, X, Y.
;
DisplayPrefixDirectory:
   lda PrefixDirectory
   beq @done
   jsr DispString
   .byte "  DIR: ",0
   ldy #0
@loop:
   lda PrefixDirectory+1,y
   jsr DispChar
   iny
   cpy PrefixDirectory
   bcc @loop
@done:
   rts

;------------------------------------------------------------------------------
; ResetLineCount
;
; Preserves the Carry flag.
;
ResetLineCount:
   lda #20
   sta LineCounter
   rts

;------------------------------------------------------------------------------
; PauseEveryNLines
;
; Result:  CLC to continue, SEC to abort
;
; X is preserved.
;
PauseEveryNLines:
   jsr DispCR
   clc
   dec LineCounter
   bne @done
   jsr PressSpaceOrESC
   jsr ResetLineCount
@done:
   rts

;------------------------------------------------------------------------------
; PressSpaceOrESC
;
; Result:  CLC to continue, SEC to abort
;
; X is preserved.
;
PressSpaceOrESC:
   jsr DispString
   .byte "[ SPACE/CR OR ESC ]",0
@key:
   jsr WaitForKey
   cmp #ESC
   beq @exit           ; Carry set if taken
   cmp #CR
   beq @space
   cmp #SPACE
   bne @key
@space:
   clc
@exit:
   php                 ; preserve Carry
   jsr DispCR
   plp
   rts

;--------------------------------------------------------------------------------------------------
;--------------------------------------------------------------------------------------------------
; API-level ProDOS disk access
;--------------------------------------------------------------------------------------------------
;--------------------------------------------------------------------------------------------------

;------------------------------------------------------------------------------
; OpenDir
;
; Prepare for one or more ReadDir or ReadDir0 calls for PrefixDirectory.
; Output: CLC for success, SEC/A=error
;
API_OpenDir:
OpenDir:
   bit ForceRootDirectorySearch
   bmi OpenRootDir

   lda PrefixDirectory    ; no prefix set?
   beq OpenRootDir

; search for the Prefix directory, and prepare to iterate it instead

   jsr DoNotUsePrefix
   ldx #>PrefixDirectory
   ldy #<PrefixDirectory
   jsr LocateDirEntryForNameXY    ; sets EntryPtr
   jsr UsePrefixNormally
   bcs @error

; EntryPtr points to our candidate directory
   jsr RequireDirectory
   bcs @error

   jsr LoadKeyBlockIntoAX
   sta FirstDirectoryBlock+1
   stx FirstDirectoryBlock
   jsr ReadDirectoryBlockAX
   bcs @error

; make sure this block looks like a valid subdirectory header
   lda DirectoryBuffer+4
   and #kStorageTypeMask
   cmp #kSubdirHeader
   beq @subdirOK
   lda #eBadStrgType
   sec
   rts
@subdirOK:
   jsr InitEntryPtrAndCount
   clc
@error:
   rts

;------------------------------------------------------------------------------
; RequireDirectory
;
; Input:   EntryPtr points to a directory entry
;
; Output:  CLC for success, or SEC/A=error
;
RequireDirectory:
   ldy #0
   lda (EntryPtr),y
   and #kStorageTypeMask
   cmp #kDirectory
   bne @notDirectory
   ldy #oFiletype
   lda (EntryPtr),y
   cmp #kFiletypeDirectory
   bne @notDirectory
   clc
   rts
@notDirectory:
   lda #eBadStrgType
   sec
   rts

;------------------------------------------------------------------------------
; OpenRootDir
;
; Prepare for one or more ReadDir or ReadDir0 calls for the root directory.
; Output: CLC for success, SEC/A=error
;
OpenRootDir:
   jsr InitEntryPtrAndCount
ReadMasterDirectoryBlock:
   lda #>kRootDirectoryBlock
   ldx #<kRootDirectoryBlock
   sta FirstDirectoryBlock+1
   stx FirstDirectoryBlock
   jsr ReadDirectoryBlockAX
   bcs @exit

   lda DirectoryBuffer+oVolStorageType
   cmp #kVolume+1
   bcc @notProDOSFormat    ; $F1 to $FF is OK (volume with Name length 1 to 15)

   lda DirectoryBuffer     ; link to previous block must be $0000
   ora DirectoryBuffer+1
   bne @notProDOSFormat

   lda DirectoryBuffer+oVolEntryLength
   cmp #kDirEntrySize
   bne @notProDOSFormat
   lda DirectoryBuffer+oVolEntriesPerBlock
   cmp #kEntriesPerBlock
   bne @notProDOSFormat

; require the bitmap base to be from 3 to 238, so all bitmap block numbers fit into 1 block
   lda DirectoryBuffer+oVolBitmapNumber+1
   bne @notProDOSFormat
   ldx DirectoryBuffer+oVolBitmapNumber
   cpx #3
   bcc @notProDOSFormat
   cpx #239
   bcs @notProDOSFormat
   stx BitmapBase

   lda DirectoryBuffer+oVolTotalBlocks+1
   ldx DirectoryBuffer+oVolTotalBlocks
   sta TotalBlocks+1
   stx TotalBlocks
   ora TotalBlocks
   beq @notProDOSFormat

; Compute number of bitmap blocks -- we have one for every 512*8 = 4096 ($1000)
; blocks (or fraction thereof) on the volume.
   lda TotalBlocks+1
   lsr a
   lsr a
   lsr a
   lsr a
   clc
   adc BitmapBase
   sta PastLastBitmapBlock
; if there is a fraction of $1000 blocks left over, we have one more bitmap block
   lda TotalBlocks+1
   and #$0F
   ora TotalBlocks
   beq @noFraction
   inc PastLastBitmapBlock
@noFraction:

   lda #0
   clc
   rts

@notProDOSFormat:
   lda #eNotProDOS
   sec
@exit:
   rts

;------------------------------------------------------------------------------
; ReadDir
;
; Find the next occupied directory entry.
; Result:  CLC for success, EntryPtr is set, DirectoryBlock is set, A=$s0 (storage type)
;          SEC/A=error
;
API_ReadDir:
ReadDir:
   jsr ReadDir0
   bcs @err
   beq ReadDir
@err:
   rts

;------------------------------------------------------------------------------
; ReadDir0
;
; Find the next directory entry, whether occupied or not.
;
; Result:  CLC for success
;              EntryPtr is set
;              DirectoryBlock is set,
;              A=$s0 (storage type)
;              BEQ for an unused entry
;          SEC/A=error
;
ReadDir0:
   jsr BumpEntryPtr
   dec EntryCounter
   bne @sameBlock

   lda DirectoryBuffer+oDirLinkNext+1
   ora DirectoryBuffer+oDirLinkNext
   beq @noMore
   lda DirectoryBuffer+oDirLinkNext+1
   ldx DirectoryBuffer+oDirLinkNext
   jsr ReadDirectoryBlockAX
   bcs @done
   jsr InitEntryPtrAndCount
@sameBlock:
   ldy #0
   lda (EntryPtr),y
   and #kStorageTypeMask     ; storage type in A ($s0), BEQ = 0
   clc
   rts
@noMore:
   lda #eFileNotFound
   sec
@done:
   rts


;------------------------------------------------------------------------------
; InitEntryPtr
;
InitEntryPtrAndCount:
   lda #kEntriesPerBlock
   sta EntryCounter
InitEntryPtr:
   lda #>DirectoryBuffer
   ldx #<DirectoryBuffer+4
   sta EntryPtr+1
   stx EntryPtr
   rts

;------------------------------------------------------------------------------
; BumpEntryPtr
;
BumpEntryPtr:
   clc
   lda EntryPtr
   adc #kDirEntrySize
   sta EntryPtr
   bcc @noCarry
   inc EntryPtr+1
@noCarry:
   rts

;------------------------------------------------------------------------------
; LoadKeyBlockIntoAX
;
; Input:    EntryPtr
; Output:   A, X (from oKeyBlock field of EntryPtr)
; Destroys: Y, P
;
LoadKeyBlockIntoAX:
   ldy #oKeyBlock
   lda (EntryPtr),y
   tax
   iny
   lda (EntryPtr),y
   rts


;------------------------------------------------------------------------------
; DoNotUsePrefix
;
; Future calls to OpenDir will operate in the root directory, not PrefixDirectory.
;
; Preserves all registers (even P).
;
DoNotUsePrefix:
   php
   sec
   ror ForceRootDirectorySearch
   plp
   rts

;------------------------------------------------------------------------------
; UsePrefixNormally
;
; Future calls to OpenDir will operate in the PrefixDirectory.
;
; Preserves all registers (even P).
;
UsePrefixNormally:
   php
   lsr ForceRootDirectorySearch
   plp
   rts


;------------------------------------------------------------------------------
; ComputeBlockCounts
;
; Result:  SEC/A=error
;          CLC, TotalBlocks, FreeBlocks, UsedBlocks
;
ComputeFreeBlocksUpTo256:
   sec
   bcs computeCommon
ComputeBlockCounts:
   clc
computeCommon:
   ror StopAfter256FreeBlocks

   jsr ReadMasterDirectoryBlock
   bcs @exit

   jsr ReadFirstBitmapBlock
   bcs @exit

; count the free blocks (bits set to "1") in every bitmap block
   lda #0
   sta FreeBlocks+1
   sta FreeBlocks

@CountOneBlock:
   ldy #0
@loop:
   lda BitmapBuffer,y
   jsr AddFreeBlocksFromA
   lda BitmapBuffer+256,y
   jsr AddFreeBlocksFromA
   iny
   bne @loop

   lda StopAfter256FreeBlocks
   bpl @countAll
   lda FreeBlocks+1
   bne @done
@countAll:

   jsr ReadNextBitmapBlock
   bcc @CountOneBlock
   cmp #eFileNotFound
   beq @done
   sec
@exit:
   rts

@done:
; compute Used blocks = Total - Free
   sec
   lda TotalBlocks
   sbc FreeBlocks
   sta UsedBlocks
   lda TotalBlocks+1
   sbc FreeBlocks+1
   sta UsedBlocks+1
   clc
   rts

;------------------------------------------------------------------------------
; AddFreeBlocksFromA
;
; Input:  A = a byte from a bitmap block
; Result: increment FreeBlocks by the number of "1" bits set in A
;
; Destroys: A, X.
; Preserves: Y.
;
AddFreeBlocksFromA:
   ldx #8         ; anticipate 8 free blocks
   cmp #$ff
   beq @done      ; special case for 8 free blocks, since it happens often

   ldx #0         ; count up the "1" bits one at a time
@loop:
   cmp #0
   beq @done
   lsr a
   bcc @loop
   inx
   bne @loop
@done:
   txa
   beq @exit
   clc
   adc FreeBlocks
   sta FreeBlocks
   bcc @exit
   inc FreeBlocks+1
@exit:
   rts

;------------------------------------------------------------------------------
; ReadFirstBitmapBlock, ReadBitmapBlockOffsetA
;
; Assumes that ReadMasterDirectoryBlock has already been called.
;
; Result:  SEC/A=error
;          CLC, BitmapBlock set, BitmapBuffer filled
;
ReadFirstBitmapBlock:
   lda #0
   sta BitmapBlock         ; means no bitmap block has already been read in
   sta BitmapDirty
ReadBitmapBlockOffsetA:
   clc
   adc BitmapBase
ReadBitmapBlockA:
   cmp BitmapBlock
   beq @sameBlock
   pha
   jsr FlushBitmap
   bcs @error1
   pla
   tax
   stx BitmapBlock
   lda #0
   jsr UseBitmapBuffer
   jmp ReadBlockAX
@sameBlock:
   clc
   rts
@error1:
   tax
   pla
   txa
   rts

;------------------------------------------------------------------------------
; ReadNextBitmapBlock
;
; Result: SEC/A=error
;         SEC/A=eFileNotFound if there are no more blocks
;         CLC, BitmapBuffer filled in, BitmapBlock adjusted
;
ReadNextBitmapBlock:
   jsr FlushBitmap
   bcs @exit
   ldx BitmapBlock
   inx
   txa
   cmp PastLastBitmapBlock
   bcc ReadBitmapBlockA
   lda #eFileNotFound
   sec
@exit:
   rts

;------------------------------------------------------------------------------
; AllocateOneBlockAX
;
; Result:  CLC, AX = block number of a freshly allocated block
;               Block number is also stored in pdBlockNumber.
;               BitmapDirty is set, BitmapBuffer is updated.
;          SEC, A = error
;
; You must have previously called ReadFirstBitmapBlock.
; Later, you have to call FlushBitmap.
;
AllocateOneBlockAX:
   clc
   ldy #0
@scan:
   lda BitmapBuffer,y
   bne @found_free
   iny
   bne @scan

   sec
@scan2:
   lda BitmapBuffer+256,y
   bne @found_free
   iny
   bne @scan2

   jsr ReadNextBitmapBlock
   bcc AllocateOneBlockAX
   rts

; SEC indicates the free block was in the 2nd half of the bitmap block
@found_free:
   php
   pha
   ldx #-1
   stx BitmapDirty
@bit:
   inx
   asl a
   bcc @bit
   pla
   plp
; X is now 0..7, the number of the lowest free block (1 bit) in the group of 8
; A is the byte, and Y is its offset within half the block, and SEC = 2nd half
   and BitmapClearMasks,x
   bcs @secondHalf
   sta BitmapBuffer,y
   bcc @more
@secondHalf:
   sta BitmapBuffer+256,y
@more:
;
; BlockNumber = (4096 * blockoffset) + (8 * Y) + (2048 * 2nd-half) + bit-position
;     BlockNumberHigh = 16*blockoffset + 8*2nd-half + Y/32
;     BlockNumberLow = (Y << 3) + bit-position
;
   lda #8
   bcs @plus2048
   lda #0
@plus2048:
   sta pdBlockNumberHigh
   tya
   lsr a
   lsr a
   lsr a
   lsr a
   lsr a
   ora pdBlockNumberHigh
   sta pdBlockNumberHigh
   sec
   lda BitmapBlock
   sbc BitmapBase
   asl a
   asl a
   asl a
   asl a
   ora pdBlockNumberHigh
   sta pdBlockNumberHigh

   tya
   asl a
   asl a
   asl a
   sta pdBlockNumberLow
   txa
   ora pdBlockNumberLow
   sta pdBlockNumberLow
   tax
   lda pdBlockNumberHigh
   clc
   rts

BitmapClearMasks:
   .byte %01111111
   .byte %10111111
   .byte %11011111
   .byte %11101111
   .byte %11110111
   .byte %11111011
   .byte %11111101
   .byte %11111110

BitmapMasks:
   .byte %10000000
   .byte %01000000
   .byte %00100000
   .byte %00010000
   .byte %00001000
   .byte %00000100
   .byte %00000010
   .byte %00000001

;------------------------------------------------------------------------------
; FreeOneBlockAX
;
; Input:  AX = block number to mark free
;
; Result: CLC for success (BitmapDirty is set, BitmapBuffer is updated)
;         SEC, A = error (eBakedBitmap if the block is invalid or already free)
;
; Destroys:  num
;
; You must have previously called ReadFirstBitmapBlock.
; Later, you have to call FlushBitmap.
;
; The bits in a block number locate a bit in the bitmap like this.  b = block
; offset of the bitmap block, H = 2nd half of the block, Y = byte offset,
; X = bit position:
;
;     b  b  b  b    H  y  y  y  y  y  y  y  y    x  x  x
;    15 14 13 12   11 10  9  8  7  6  5  4  3    2  1  0
;
FreeOneBlockAX:
   sta num+1
   stx num
   lsr a
   lsr a
   lsr a
   lsr a
   jsr ReadBitmapBlockOffsetA     ; block offset = block/256 / 16
   bcs @exit

   lda num
   and #7                         ; X = bits 0 to 2 of block number
   tax

   lsr num+1
   ror num
   lsr num+1
   ror num
   lsr num+1
   ror num
   ldy num                        ; Y = bits 3 to 10 of block number

   lsr num+1                      ; bit 11 of block number puts us in 2nd half of a bitmap block
   bcs @highHalf

   lda BitmapBuffer,y
   ora BitmapMasks,x
   cmp BitmapBuffer,y
   beq @bakedBitmap               ; block was already free
   sta BitmapBuffer,y
   bne @common

@highHalf:
   lda BitmapBuffer+256,y
   ora BitmapMasks,x
   cmp BitmapBuffer+256,y
   beq @bakedBitmap
   sta BitmapBuffer+256,y

@common:
   sec
   ror BitmapDirty
   clc
   rts

@bakedBitmap:
   lda #eBakedBitmap
   sec
@exit:
   rts

;------------------------------------------------------------------------------
; FlushBitmap
;
; Writes the current bitmap block to disk, if it's dirty.
;
FlushBitmap:
   bit BitmapDirty
   bpl @clean
   lsr BitmapDirty
   lda #0
   ldx BitmapBlock
   jsr UseBitmapBuffer
   jmp WriteBlockAX
@clean:
   clc
   rts

;------------------------------------------------------------------------------
; GetFileInfo
;
; Input:  Filename = pointer to name, starting with length byte ($05, "HELLO")
;
; Output: Filetype, Auxtype, FileSize (just 2 bytes)
;
GetFileInfo:
   jsr UsePrefixNormally
   jsr LocateDirEntryForFilename
   bcs @exit

   ldy #oFiletype
   lda (EntryPtr),y
   sta Filetype

   ldy #oAuxtype
   lda (EntryPtr),y
   sta Auxtype
   iny
   lda (EntryPtr),y
   sta Auxtype+1

   ldy #oFileSize
   lda (EntryPtr),y
   sta FileSize
   iny   
   lda (EntryPtr),y
   sta FileSize+1
   clc
@exit:
   rts

;------------------------------------------------------------------------------
; ReadFileAtAX
;
; Input:  Filename = pointer to name, starting with length byte ($05, "HELLO")
;         AX = starting address ($0000 to use the file's Auxtype)
;
; ReadFileWithSpecialFirstBlock -- If the first block is special, we load it
; as requested, and the other blocks are loaded as usual (starting at Destination).
;
ReadFileAtAX:
   sta Destination+1
   stx Destination

API_ReadFile:
ReadFile:
   lda #0
ReadFileWithSpecialFirstBlock:
   sta SpecialFirstBlock

   jsr UsePrefixNormally
   jsr LocateDirEntryForFilename
   bcs @exit

   ldy   #0
   lda   (EntryPtr),y         ; storage type + length
   cmp   #kTree               ; only storage types 1 and 2 are OK
   bcs   @badStorageType
   cmp   #kSeedling+1
   bcc   @badStorageType

   ldy   #oAccess             ; make sure we're permitted Read access to this file
   lda   (EntryPtr),y
   and   #kAccessRead
   bne   @allowed
   lda   #eFileLocked
   sec
   rts
@allowed:

   ldy   #oKeyBlock
   lda   (EntryPtr),y
   sta   pdBlockNumberLow
   iny
   lda   (EntryPtr),y
   sta   pdBlockNumberHigh

   ldy   #oFileSize
   lda   (EntryPtr),y
   sta   FileSize
   iny   
   lda   (EntryPtr),y
   sta   FileSize+1

   lda   Destination+1
   ora   Destination
   bne   @validate
   ldy   #oAuxtype           ; use Auxtype for destination
   lda   (EntryPtr),y
   sta   Destination
   iny
   lda   (EntryPtr),y
   sta   Destination+1
@validate:
   lda   Destination+1
   cmp   #2                  ; prohibit a read below address $0200
   bcs   @destOK
   lda   #eBadBufferAddr
   sec
@exit:
   rts
@destOK:

   ldy   #0
   lda   (EntryPtr),y         ;storage type + length
   and   #kStorageTypeMask
   cmp   #kSeedling
   beq   @readSeedling
   cmp   #kSapling
   beq   @readSapling
@badStorageType:
   lda   #eBadStrgType
   sec
   rts

@readSeedling:
   jsr   UseDestination
   jmp   DoReadBlock

@readSapling:
   jsr   UseBuffer
   jsr   DoReadBlock
   bcs   @exit
   jsr   UseDestination
   lda   #0
   sta   BlockIndex
   lda   SpecialFirstBlock
   bne   @specialFirstBlock
@nextBlock:
   ldy   BlockIndex
   lda   buffer,y
   tax
   lda   buffer+256,y
   jsr   ReadBlockAXOrZeroes
   bcs   @exit
   inc   pdIOBufferHigh
   inc   pdIOBufferHigh
@did1block:
   lda   FileSize+1
   dec   FileSize+1
   dec   FileSize+1
   cmp   #2
   bcc   @finished
   bne   @moreWork
   lda   FileSize
   beq   @finished
@moreWork:
   inc   BlockIndex
   bne   @nextBlock

@finished:
   lda   #0
   clc
   rts

@specialFirstBlock:
   jsr UseDestinationOrSpecialBuffer
   lda buffer+256
   ldx buffer
   jsr ReadBlockAX
   jsr UseDestination
   bcc @did1block
   rts

;------------------------------------------------------------------------------
; 4K boundary -- Move this up or down in the source code as needed, if the space
;                before or after becomes full.
;
; The firmware lives at $9000, but during development it used to live at $A000.
; Prevent anything bad from happening if someone accidentally calls one of the
; old $A00x entry points.
;------------------------------------------------------------------------------
   .res Origin+4096-*
   nop
   nop
   nop
   nop
   nop
   nop
   nop
   nop
   nop
   nop
   nop
   nop
 .if APPLE2
   jmp     $FF69        ; Apple II monitor
 .else
   jmp     APPLE1_MON
 .endif
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
; Rename
;
; Input:  OldFilename = original name
;         Filename = new name
;
; Result: CLC for success
;         SEC, A = error
;
API_Rename:
Rename:
   jsr UsePrefixNormally
; first, find the original (file-not-found takes precedence over duplicate-file)
   ldx OldFilename+1
   ldy OldFilename
   jsr LocateDirEntryForNameXY
   bcs @exit

; see if we're allowed to rename this file
   ldy #oAccess
   lda (EntryPtr),y
   and #kAccessRename
   beq rename_no_access

; make sure it's a storage type we can deal with (seedling, sapling, tree, directory)
   ldy #0
   lda (EntryPtr),y
   and #kStorageTypeMask
   sta Filetype               ; really storage type -- needed below for directories
   cmp #kTree+1
   bcc @storage_type_ok
   cmp #kDirectory
   beq @storage_type_ok
   lda #eBadStrgType
   sec
   rts
@storage_type_ok:

; make sure there is no file already using the new name
   jsr LocateDirEntryForFilename
   bcc @duplicate             ; oops, it already exists
   cmp #eFileNotFound         ; we expect file-not-found, and any other error means we're done
   bne @error

   ldx OldFilename+1
   ldy OldFilename
   jsr LocateDirEntryForNameXY
   bcs @exit

; replace the entry's filename, updating the length (but leaving the storage type untouched)
   ldy #0
   lda (Filename),y        ; length
   tay
@copy:
   lda (Filename),y
   sta (EntryPtr),y
   dey
   bne @copy

   lda (EntryPtr),y
   and #kStorageTypeMask
   ora (Filename),y        ; update the name length, leaving storage type unchanged
   sta (EntryPtr),y
   jsr WriteCurrentDirectoryBlock
   bcs @exit

   ldx Filetype           ; storage type
   cpx #kDirectory
   beq finishRenamingDirectory
   clc
;  lda #0                 ; A is still zero from WriteBlock
   rts

@duplicate:
   lda #eDuplicateFile
@error:
   sec
@exit:
   rts
rename_no_access:
delete_no_access:
   lda #eFileLocked
   sec
   rts

finishRenamingDirectory:
   jsr UseBuffer
   jsr LoadKeyBlockIntoAX
   jsr ReadBlockAX
   bcs @exit

; replace the filename in the directory header
   ldy #0
   lda (Filename),y        ; length
   tay
@copy:
   lda (Filename),y
   sta buffer+oVolStorageType,y
   dey
   bne @copy
   lda (Filename),y        ;length
   ora #kSubdirHeader
   sta buffer+oVolStorageType
   jmp DoWriteBlock
@exit:
   rts


;------------------------------------------------------------------------------
; Delete
;
; Input:  Filename
; Result: CLC for success
;         SEC, A = error
;
API_Delete:
Delete:
   jsr UsePrefixNormally
   jsr LocateDirEntryForFilename
   bcc @continue
@exit:
   rts
@continue:

; see if we're permitted to delete this file
   ldy #oAccess
   lda (EntryPtr),y
   and #kAccessDelete
   beq delete_no_access

   jsr ReadFirstBitmapBlock
   bcs @exit

; see if it's a storage type we know how to delete (seedling or sapling)
   ldy #0
   lda (EntryPtr),y
   and #kStorageTypeMask
   cmp #kSeedling
   beq @delete_seedling
   cmp #kSapling
   beq @delete_sapling
   cmp #kDirectory
   beq @delete_directory
   lda #eBadStrgType
   sec
@exit2:
   rts

@delete_directory:
   jsr UseBuffer
   jsr LoadKeyBlockIntoAX
   jsr ReadBlockAX
   bcs @exit2
; we can only delete the directory if it's empty
   lda buffer+oVolFileCount
   ora buffer+oVolFileCount+1
   bne delete_no_access
@freeNextDirBlock:
   lda pdBlockNumberHigh
   ldx pdBlockNumberLow
   jsr FreeOneBlockAX
   bcs @exit2
   lda buffer+oDirLinkNext+1
   ora buffer+oDirLinkNext
   beq @common
   lda buffer+oDirLinkNext+1
   ldx buffer+oDirLinkNext
   jsr ReadBlockAX
   bcc @freeNextDirBlock
   bcs @exit2

@delete_seedling:
   jsr LoadKeyBlockIntoAX
   jsr FreeOneBlockAX
@exit3:
   bcs @exit2
   bcc @common

@delete_sapling:
; read the index block
   jsr LoadKeyBlockIntoAX
   jsr UseBuffer
   jsr ReadBlockAX
   bcs @exit2
; free the data blocks
   ldy #0
@loop:
   lda buffer,y
   ora buffer+256,y
   beq @skip
   sty BlockIndex
   lda buffer,y
   tax
   lda buffer+256,y
   jsr FreeOneBlockAX
   bcs @exit2
   ldy BlockIndex
@skip:
   iny
   bne @loop
; free the index block
   jsr LoadKeyBlockIntoAX
   jsr FreeOneBlockAX
   bcs @exit3

@common:
; Change the directory entry's storage type and name length to 0
; (leaving the length in place makes Mr.Fixit claim "incomplete delete")
   ldy #0
   tya
   sta (EntryPtr),y

FlushBitmapAndDecrementFileCount:
   jsr FlushBitmap
   bcs @exit
   jsr FlushAndReadFirstDirectoryBlock

; decrement the file count in the directory header
   sec
   lda DirectoryBuffer+oVolFileCount
   sbc #1
   sta DirectoryBuffer+oVolFileCount
   bcs @noBorrow
   dec DirectoryBuffer+oVolFileCount+1
@noBorrow:
   jmp WriteCurrentDirectoryBlock

@exit:
   rts

;==============================================================================
;------------------------------------------------------------------------------
; $A240 = CALL -24000  -- convenient entry point from BASIC.
;
; Move this up or down in the source code as needed, if the space before or
; after becomes full.
;------------------------------------------------------------------------------
 .if APPLE2
 .else
   .res $A240-*
   jmp MenuExitToBASIC
 .endif
;------------------------------------------------------------------------------
;==============================================================================



;------------------------------------------------------------------------------
; WriteFile
;
; Input:  Filename
;         Destination = starting address
;         FileSize    = number of bytes to write
;         Filetype
;         Auxtype
; Result: CLC for success
;         SEC, A = error
;
; Creates a new file, or replaces an existing file with the same name.
;
API_WriteFile:
WriteFile:
   lda #0
WriteFileWithSpecialFirstBlock:
   sta SpecialFirstBlock
   jsr Delete           ; note that this validates the Filename syntax & uppercases it
   bcc @continue
   cmp #eFileNotFound   ; file-not-found is OK, but any other error means we're done
   beq @continue
   sec
@exit:
   rts
@continue:

; See if the disk has enough free blocks for our file
   jsr ComputeFreeBlocksUpTo256
   bcs @exit
   jsr BlocksNeededFromFileSize
   sta UsedBlocks        ; now "blocks needed" (1 byte)

   lda FreeBlocks+1
   bne @enough_room      ; 256 or more free blocks is plenty
   lda FreeBlocks
   cmp UsedBlocks
   bcs @enough_room
   lda #eVolumeFull
   sec
   rts
@enough_room:

   jsr LocateAvailableDirEntry
   bcs @exit

   ldy #kDirEntrySize-1
   lda #0
@zero:
   sta (EntryPtr),y
   dey
   bpl @zero

   ldy #0
   lda (Filename),y
   tay
@copyName:
   lda (Filename),y
   sta (EntryPtr),y
   dey
   bpl @copyName

; set the filetype & auxtype
   ldy #oFiletype
   lda Filetype
   sta (EntryPtr),y

   ldy #oAuxtype
   lda Auxtype
   sta (EntryPtr),y
   iny
   lda Auxtype+1
   sta (EntryPtr),y

; set the block count
   ldy #oBlockCount
   lda UsedBlocks
   sta (EntryPtr),y
   iny
   lda #0
   sta (EntryPtr),y

; set the storage type to Seeding or Sapling (use UsedBlocks for this)
   lda #kSeedling
   ldx UsedBlocks
   cpx #2
   bcc @setStorageType
   lda #kSapling
@setStorageType:
   ldy #0
   ora (EntryPtr),y
   sta (EntryPtr),y

; set the access to Unlocked
   ldy #oAccess
   lda #kAccessFull+kAccessNeedsBackup
   sta (EntryPtr),y

; set the end of file (3 bytes) from FileSize
   ldy #oFileSize
   lda FileSize
   sta (EntryPtr),y
   iny
   lda FileSize+1
   sta (EntryPtr),y

; set Version, Minimum version
   ldy #oVersion
   lda #0
   sta (EntryPtr),y    ; version = 0
   iny
   sta (EntryPtr),y    ; min version = 0

; set the Header Pointer field to the first block of the directory
   ldy #oHeaderPointer
   lda FirstDirectoryBlock
   sta (EntryPtr),y
   iny
   lda FirstDirectoryBlock+1
   sta (EntryPtr),y

; allocate the key block & store it into the directory entry
   jsr ReadFirstBitmapBlock
   bcs @exit2
   jsr AllocateOneBlockAX    ;also sets pdBlockNumber
   bcs @exit2

   ldy #oKeyBlock+1
   sta (EntryPtr),y
   txa
   dey
   sta (EntryPtr),y

   lda UsedBlocks
   cmp #2
   bcs @writeSapling

@writeSeedling:
   jsr UseDestination
   jsr DoWriteBlock
   bcc @updateFileCount
@exit2:
   rts

@writeSapling:
   jsr ZeroBuffer
   sta BlockIndex            ;zero

@loop:
   jsr AllocateOneBlockAX    ;also sets pdBlockNumber
   bcs @exit2

   ldy BlockIndex
   sta buffer+256,y
   txa
   sta buffer,y

   jsr UseDestinationOrSpecialBuffer
   jsr DoWriteBlock
   bcs @exit2

   inc Destination+1
   inc Destination+1
   inc BlockIndex
   lda FileSize+1
   dec FileSize+1
   dec FileSize+1
   cmp #2
   bcc @finished
   bne @loop
   lda FileSize
   bne @loop
@finished:

; write index block (its block number is in the directory entry at oKeyBlock)
   jsr UseBuffer
   jsr LoadKeyBlockIntoAX
   jsr WriteBlockAX
   bcs @exit2

@updateFileCount:
FlushBitmapAndIncrementFileCount:
   jsr FlushBitmap
   bcs @exit
   jsr FlushAndReadFirstDirectoryBlock

; increment the file count in the directory header
   inc DirectoryBuffer+oVolFileCount
   bne @noCarry
   inc DirectoryBuffer+oVolFileCount+1
@noCarry:
   jmp WriteCurrentDirectoryBlock

@exit:
   rts

;------------------------------------------------------------------------------
; LoadBASICFile
;
; Input:  Filename
;
; We need to load the first block of the file into StagingBuffer, and then copy
; part of it into zero page at $4A..FF.  The rest of the file loads starting
; at the file's auxtype, which should match the stored LOMEM value.
;
; We call ReadFile with a special request that it read the first block into
; StagingBuffer.
;
API_LoadBASICFile:
LoadBASICFile:
   jsr UsePrefixNormally
   lda #0
   sta Destination+1
   sta Destination
   lda #>StagingBuffer
   jsr ReadFileWithSpecialFirstBlock
   bcs @exit

   ldy #oFiletype
   lda (EntryPtr),y
   cmp #kFiletypeBASIC1
   bne @unknownFormat

   lda StagingBuffer
   cmp #'A'
   bne @unknownFormat
   lda StagingBuffer+1
   cmp #'1'
   bne @unknownFormat
   lda StagingBuffer+2   ; version, must be 0
   beq @ok
@unknownFormat:
   lda #eUnknownBASICFormat
   sec
@exit:
   rts
@ok:

   ldx #$4A
@copyZP:
   lda StagingBuffer,x
 .if APPLE2
   sta $800,x
 .else
   sta 0,x
 .endif
   inx
   bne @copyZP

   lda #0
   clc
   rts

;------------------------------------------------------------------------------
; SaveBASICFile
;
; Input:  Filename
;
; We need to save zero page from $4A..FF, and all the memory between LOMEM
; and HIMEM.  We'll call WriteFile with a special request that it write from
; StagingBuffer as the first block.  The FileSize and Destination address we
; request allow for the extra data in StagingBuffer.
;
API_SaveBASICFile:
SaveBASICFile:
   lda #0
   tax
@zero:
   sta StagingBuffer,x
   sta StagingBuffer+256,x
   dex
   bne @zero

   lda #'A'
   sta StagingBuffer
   lda #'1'
   sta StagingBuffer+1
; StagingBuffer+2 is the file format version.  Leave it as 0 for now.

   ldx #$4A
@copyZP:
   lda 0,x
   sta StagingBuffer,x
   inx
   bne @copyZP

   ldx LOMEM+1
   ldy LOMEM
   stx Auxtype+1
   sty Auxtype
   dex
   dex               ; subtract 2 to allow for extra buffer
   stx Destination+1
   sty Destination

   sec
   lda HIMEM
   sbc LOMEM
   sta FileSize
   lda HIMEM+1
   sbc LOMEM+1
   bcc @error
   adc #1             ; adds 2, since carry is set
   sta FileSize+1

   lda #kFiletypeBASIC1
   sta Filetype
   lda #>StagingBuffer
   jmp WriteFileWithSpecialFirstBlock

@error:
   lda #eBadBufferAddr
   sec
   rts


;------------------------------------------------------------------------------
; NewDirectoryAtRoot
;
; Input:   Filename = name of directory
; Output:  CLC for success, SEC/A=error
;
API_NewDirectoryAtRoot:
NewDirectoryAtRoot:
   jsr DoNotUsePrefix
   jsr LocateDirEntryForFilename
   jsr UsePrefixNormally
   bcc @dup
   cmp #eFileNotFound
   beq @continue
   sec
   rts
@dup:
   lda #eDuplicateFile
   sec
@exit:
   rts

@continue:
   jsr DoNotUsePrefix
   jsr LocateAvailableDirEntry
   jsr UsePrefixNormally
   bcs @exit

; zero out the new directory entry
   ldy #kDirEntrySize-1
   lda #0
@zero:
   sta (EntryPtr),y
   dey
   bpl @zero

; construct the dir entry (EntryPtr) in parallel with the directory header (Buffer)
   jsr ZeroBuffer

; allocate the new dir's key block & store it into the directory entry
   jsr ReadFirstBitmapBlock
   bcs @exit
   jsr AllocateOneBlockAX    ;also sets pdBlockNumber
@exit1:
   bcs @exit

   ldy #oKeyBlock+1
   sta (EntryPtr),y
   txa
   dey
   sta (EntryPtr),y

; set the name
   ldy #0
   lda (Filename),y
   tay
@copyName:
   lda (Filename),y
   sta (EntryPtr),y
   sta buffer+oVolStorageType,y
   dey
   bpl @copyName

; set the storage type to Directory
   lda #kDirectory
   ldy #0
   ora (EntryPtr),y
   sta (EntryPtr),y
; set the dir header's storage type
   lda #kSubdirHeader
   ora buffer+oVolStorageType
   sta buffer+oVolStorageType

; set the filetype
   ldy #oFiletype
   lda #kFiletypeDirectory
   sta (EntryPtr),y

; set the block count to 1
   ldy #oBlockCount
   lda #1
   sta (EntryPtr),y

; set the access to Unlocked
   ldy #oAccess
   lda #kAccessFull+kAccessNeedsBackup
   sta (EntryPtr),y
   sta buffer+oVolAccess

; set the end of file (3 bytes) to $0200
   ldy #oFileSize+1
   lda #$02
   sta (EntryPtr),y

; set the Header Pointer field to the first block of the (root) directory
   ldy #oHeaderPointer
   lda FirstDirectoryBlock
   sta (EntryPtr),y
   iny
   lda FirstDirectoryBlock+1
   sta (EntryPtr),y

; set entry_length, parent_entry_length
   lda #kDirEntrySize
   sta buffer+oVolEntryLength
   sta buffer+oSubdirParentEntryLength
; set entries per block
   lda #kEntriesPerBlock
   sta buffer+oVolEntriesPerBlock

; parent_pointer (block #), parent_entry_number (subdir header knows where its directory entry is)
   lda DirectoryBlock+1
   ldx DirectoryBlock
   sta buffer+oSubdirParentPointer+1
   stx buffer+oSubdirParentPointer

; compute parent entry number = entries-per-block + 1 - EntryCounter
   sec
   lda #kEntriesPerBlock+1
   sbc EntryCounter
   sta buffer+oSubdirParentEntryNum

; finish up by writing the directory's first block and the directory entry
   jsr UseBuffer
   jsr DoWriteBlock
   bcs @exit1

   jmp FlushBitmapAndIncrementFileCount


;------------------------------------------------------------------------------
; SetPrefix
;
; Input:   Filename = name of directory (empty = use root)
;
SetPrefix:
   ldy #0
   lda (Filename),y
   beq @emptyPrefix

   jsr DoNotUsePrefix
   jsr LocateDirEntryForFilename
   jsr UsePrefixNormally
   bcs @error
   jsr RequireDirectory
   bcs @error

@emptyPrefix:
   ldy #15
@copyPrefix:
   lda (Filename),y
   sta PrefixDirectory,y
   dey
   bpl @copyPrefix

   lda #0
   sec
@error:
   rts


;------------------------------------------------------------------------------
; FormatDrive
;
; Input:   Filename = volume name
;          DriveNumber
;
FormatDrive:
   jsr SyntaxCheckFilename
   bcs @exit

; GetStatus for the block count.
   lda #PRODOS_STATUS
   sta pdCommandCode
   jsr CFBlockDriver
   bcs @exit
   sty TotalBlocks+1
   stx TotalBlocks
   tya
   bne @enoughBlocks
   lda #PRODOS_BADBLOCK
   sec
@exit:
   rts
@enoughBlocks:

; Zero out blocks 0 through 64
   jsr ZeroBuffer
   jsr UseBuffer
   lda #0
   ldx #64
   sta pdBlockNumberHigh
   stx pdBlockNumberLow
@zeroBlocks:
   jsr DoWriteBlock
   bcs @exit
   dec pdBlockNumberLow
   bpl @zeroBlocks

; Construct and write block 2, the main directory block.
   ldy #0
   lda (Filename),y
   tay
@copyName:
   lda (Filename),y
   sta buffer+oVolStorageType,y
   dey
   bpl @copyName
   ora #kVolume
   sta buffer+oVolStorageType

   lda #kRootDirectoryBlock+1
   sta buffer+oDirLinkNext
   lda #5
   sta buffer+oVolVersion
   lda #kAccessFull+kAccessNeedsBackup
   sta buffer+oVolAccess
   lda #kDirEntrySize
   sta buffer+oVolEntryLength
   lda #kEntriesPerBlock
   sta buffer+oVolEntriesPerBlock
   lda #kCanonicalFirstBitmapBlock
   sta buffer+oVolBitmapNumber
   sta BitmapBase
   lda TotalBlocks+1
   ldx TotalBlocks
   sta buffer+oVolTotalBlocks+1
   stx buffer+oVolTotalBlocks


   lda #>kRootDirectoryBlock
   ldx #<kRootDirectoryBlock
   jsr WriteBlockAX
   bcs @exit

; Construct and write blocks 3, 4, 5 (just links to the other blocks).
@nextBlock:
   jsr ZeroBuffer
   inc pdBlockNumberLow
   ldx pdBlockNumberLow
   cpx #kCanonicalFirstBitmapBlock
   bcs @finishedCatalog
   dex
   stx buffer+oDirLinkPrevious
   inx
   inx
   cpx #kCanonicalFirstBitmapBlock
   bcs @noNextLink
   stx buffer+oDirLinkNext
@noNextLink:
   jsr DoWriteBlock
   bcc @nextBlock
   rts
@finishedCatalog:

; Construct and write the volume bitmap.
;
; Number of blocks is ceiling(TotalBlocks / 4096), which is the same as
; TotalBlocks/256/ 16, plus 1 if there are any extra blocks (mod 4096).
;
   lda TotalBlocks+1
   lsr a
   lsr a
   lsr a
   lsr a
   clc
   adc #kCanonicalFirstBitmapBlock
   tax
   lda TotalBlocks+1
   and #$0F
   ora TotalBlocks
   beq @noExtra
   inx
@noExtra:
   stx PastLastBitmapBlock

@nextBitmapBlock:
   ldx pdBlockNumberLow
   inx
   cpx PastLastBitmapBlock
   bne @fullOfFreeBlocks
   jsr PopulateFinalBitmapBlock
   jmp @writeBitmapBlock

@fullOfFreeBlocks:
   lda #$ff
   ldx #0
@allFree:
   sta buffer,x
   sta buffer+256,x
   dex
   bne @allFree

@writeBitmapBlock:
   jsr DoWriteBlock
   bcs @exit2

   inc pdBlockNumberLow
   lda pdBlockNumberLow
   cmp PastLastBitmapBlock
   bcc @nextBitmapBlock

; Mark blocks 0..LastBitmapBlock as used.
   jsr ReadFirstBitmapBlock
   bcs @exit2
@allocateTheEarlyBlocks:
   jsr AllocateOneBlockAX
   bcs @exit2
   inx
   cpx PastLastBitmapBlock
   bcc @allocateTheEarlyBlocks
   jmp FlushBitmap

@exit2:
   rts

;------------------------------------------------------------------------------
; PopulateFinalBitmapBlock
;
; Input:  TotalBlocks, TotalBlocks+1
;         pdIOBuffer points to buffer
;
; Result: Fills in buffer (512 bytes) by setting the first (TotalBlocks % 4096)
;         bits to 1 (free), and the rest of the bits to 0.
;
PopulateFinalBitmapBlock:
   lda pdIOBufferHigh
   pha
   jsr ZeroBuffer
   lda TotalBlocks+1
   and #$08
   beq @lessThanHalf

   lda #$ff
   ldx #0
@freeFirstHalf:
   sta buffer,x
   dex
   bne @freeFirstHalf
   inc pdIOBufferHigh

@lessThanHalf:
   lda TotalBlocks+1
   lsr a
   sta num+1
   lda TotalBlocks
   ror a
   lsr num+1
   ror a
   lsr num+1
   ror a
   tax
   lda #$ff
   ldy #0
@free8:
   sta (pdIOBufferLow),y
   iny
   dex
   bne @free8

; Mark as free the last left-over 1 to 7 blocks.
   lda TotalBlocks
   and #7
   beq @noMore
   tax
   lda BitmapNFreeBlocksMasks,x
   sta (pdIOBufferLow),y
@noMore:

   pla
   sta pdIOBufferHigh
   rts

BitmapNFreeBlocksMasks:
   .byte %00000000
   .byte %10000000
   .byte %11000000
   .byte %11100000
   .byte %11110000
   .byte %11111000
   .byte %11111100
   .byte %11111110

;--------------------------------------------------------------------------------------------------
;--------------------------------------------------------------------------------------------------
; Utility routines
;--------------------------------------------------------------------------------------------------
;--------------------------------------------------------------------------------------------------

;------------------------------------------------------------------------------
; ZeroBuffer
;
; Result:  512 bytes of 0 in buffer
;          A = 0, X = 0
;
ZeroBuffer:
   lda #0
   tax
@zeroIndex:
   sta buffer,x
   sta buffer+256,x
   dex
   bne @zeroIndex
   rts

;------------------------------------------------------------------------------
; LocateDirEntryForNameXY
;
; Input:  XY = pointer to filename
; Result: Like LocateDirEntryForFilename
;         (Filename is preserved.)
;
LocateDirEntryForNameXY:
   lda Filename+1
   pha
   lda Filename
   pha

   stx Filename+1
   sty Filename
   jsr LocateDirEntryForFilename

   tax
   pla
   sta Filename
   pla
   sta Filename+1
   txa
   rts

;------------------------------------------------------------------------------
; LocateDirEntryForFilename
;
; Input:   Filename
; Result:  CLC, EntryPtr is set, DirectoryBlock is set
;          SEC, A = error (typically eFileNotFound, eBadPathSyntax)
;
API_FindDirEntry:
LocateDirEntryForFilename:
   jsr SyntaxCheckFilename
   bcs @exit

   jsr OpenDir
   bcs @exit
@next:
   jsr ReadDir
   bcs @exit

   ldy #0
   lda (EntryPtr),y
   and #$0f            ; strip off the storage type
   cmp (Filename),y    ; correct length?
   bne @next
   tay
@checkName:
   lda (EntryPtr),y
   cmp (Filename),y
   bne @next
   dey
   bne @checkName
   clc
@exit:
   rts

;------------------------------------------------------------------------------
; LocateAvailableDirEntry
;
; Result:  CLC, EntryPtr is set, DirectoryBlock is set
;          SEC, A = error
;
; Destroys "buffer" if we have to add a block to the directory.
;
LocateAvailableDirEntry:
   jsr OpenDir
   bcs @error
@next:
   jsr ReadDir0
   bcs @error
   bne @next
   clc
   rts

@error:
   cmp #eFileNotFound
   bne @otherError

   lda FirstDirectoryBlock+1
   bne @extendSubdir
   lda FirstDirectoryBlock
   cmp #kRootDirectoryBlock
   bne @extendSubdir

   lda #eDirectoryFull
@otherError:
   sec
@exit:
   rts

@extendSubdir:
   jsr ZeroBuffer

   jsr ReadFirstBitmapBlock
   bcs @exit
   jsr AllocateOneBlockAX
   bcs @exit
   sta DirectoryBuffer+oDirLinkNext+1
   stx DirectoryBuffer+oDirLinkNext

   jsr FlushBitmap
   bcs @exit

; write the new block, with a prev-link to the old last block
   lda DirectoryBlock+1
   ldx DirectoryBlock
   sta buffer+oDirLinkPrevious+1
   stx buffer+oDirLinkPrevious

   jsr UseBuffer
   lda DirectoryBuffer+oDirLinkNext+1
   ldx DirectoryBuffer+oDirLinkNext
   jsr WriteBlockAX
   bcs @exit

; update what used to be the last block, with a next-link to the new block
   jsr WriteCurrentDirectoryBlock
   bcs @exit

; find parent directory entry -- update block count, EOF
   jsr FlushAndReadFirstDirectoryBlock
   bcs @exit

   lda DirectoryBuffer+oVolStorageType
   and #kStorageTypeMask
   cmp #kSubdirHeader
   bne @fileFormatError

   lda DirectoryBuffer+oSubdirParentEntryNum
   beq @fileFormatError
   cmp #kEntriesPerBlock+1
   bcs @fileFormatError
   sta EntryCounter

   lda DirectoryBuffer+oSubdirParentPointer+1
   ldx DirectoryBuffer+oSubdirParentPointer
   jsr ReadDirectoryBlockAX
   bcs @exit

   jsr InitEntryPtr
@loop:
   dec EntryCounter
   beq @done
   jsr BumpEntryPtr
   jmp @loop
@done:

   ldy #oBlockCount
   lda #1
   jsr AddToTwoByteEntryPtrField

   ldy #oFileSize+1
   lda #2
   jsr AddToTwoByteEntryPtrField

   jsr WriteCurrentDirectoryBlock
   bcs @exit

; Start over from the beginning of the directory (inefficient, but easy)
   jmp LocateAvailableDirEntry

@fileFormatError:
   lda #eFileFormat
   sec
   rts

;------------------------------------------------------------------------------
; AddToTwoByteEntryPtrField
;
; Input:   A = value to add
;          Y = offset into (EntryPtr)
;
; Destroyes:  A, Y.
;
AddToTwoByteEntryPtrField:
   clc
   adc (EntryPtr),y
   sta (EntryPtr),y
   iny
   lda (EntryPtr),y
   adc #0
   sta (EntryPtr),y
   rts


;------------------------------------------------------------------------------
; SyntaxCheckFilename
;
; Input:   Filename
; Result:  CLC, any lowercase letters in Filename are changed to uppercase
;          SEC, A = error
;
; A valid filename has a length from 1 to 15.  The first character must be A-Z,
; and the following characters must be A-Z, 0-9, or period.
;
SyntaxCheckFilename:
   ldy #0
   lda (Filename),y    ; correct length?
   beq @syntax_bad
   cmp #16
   bcs @syntax_bad
   tay
@char:
   lda (Filename),y

   cmp #'z'+1
   bcs @syntax_bad
   cmp #'a'
   bcc @not_lowercase
   and #%11011111
   sta (Filename),y
   bne @next
@not_lowercase:

   cmp #'Z'+1
   bcs @syntax_bad
   cmp #'A'
   bcs @next

   cpy #1
   beq @syntax_bad      ; first character must be a letter

   cmp #'9'+1
   bcs @syntax_bad
   cmp #'0'
   bcs @next

   cmp #'.'
   bne @syntax_bad

@next:
   dey
   bne @char
   clc
   rts

@syntax_bad:
   lda #eBadPathSyntax
   sec
   rts

;------------------------------------------------------------------------------
; BlocksNeededFromFileSize
;
; Input:  FileSize (2 bytes)
; Result: A = Number of disk blocks needed
;
; Destroys X.
;
; Compute  max(1, ceiling(FileSize / 512)), and then
; add one more for a sapling file's index block.
;
BlocksNeededFromFileSize:
   lda FileSize+1
   lsr a
   tax                     ; X = FileSize / 512
   lda #0
   ror a                   ; A is nonzero if FileSize+1 was odd
   ora FileSize
   beq @noExtraBytes
   inx                     ; add 1 more block if there was a remainder
@noExtraBytes:
   cpx #2
   bcc @needsJustOneBlock  ; 0 or 1 -> 1
   inx                     ; 1 more for the index block
   txa
   rts

@needsJustOneBlock:
   lda #1
   rts


;------------------------------------------------------------------------------
UseBuffer:
   ldy #>buffer
   bne ioBufferY
;------------------------------------------------------------------------------
UseDirectoryBuffer:
   ldy #>DirectoryBuffer
   bne ioBufferY
;------------------------------------------------------------------------------
; Sets pdIOBuffer.  Preserves A,X and returns with Y=0.
;
UseBitmapBuffer:
   ldy #>BitmapBuffer
ioBufferY:
   sty pdIOBufferHigh
   ldy #0
   sty pdIOBufferLow
   rts

;------------------------------------------------------------------------------
UseDestinationOrSpecialBuffer:
   ldy SpecialFirstBlock
   beq UseDestination
   jsr ioBufferY
   sty SpecialFirstBlock
   rts
UseDestination:
   ldy Destination+1
   sty pdIOBufferHigh
   ldy Destination
   sty pdIOBufferLow
   rts

;------------------------------------------------------------------------------
; ReadBlockAXOrZeroes
;
; Read any block except #0.  If asked to read block 0, fill the buffer with
; 512 bytes of $00 instead.  This facilitates reading a sparse file, where
; the index block entry for a missing portion of a file is 0.
;
ReadBlockAXOrZeroes:
   sta   pdBlockNumberHigh
   stx   pdBlockNumberLow
   ora   pdBlockNumberLow
   bne   DoReadBlock
   tay
@zero1:
   sta   (pdIOBufferLow),y
   iny
   bne   @zero1
   inc   pdIOBufferHigh   
@zero2:
   sta   (pdIOBufferLow),y
   iny
   bne   @zero2
   dec   pdIOBufferHigh
   clc
   rts

;------------------------------------------------------------------------------
WriteCurrentDirectoryBlock:
   jsr UseDirectoryBuffer
   lda DirectoryBlock+1
   ldx DirectoryBlock
WriteBlockAX:
   sta pdBlockNumberHigh
   stx pdBlockNumberLow
DoWriteBlock:
   lda #PRODOS_WRITE
   sta pdCommandCode
   bne CFBlockDriver

;------------------------------------------------------------------------------
; FlushAndReadFirstDirectoryBlock, FlushAndReadDirectoryBlockAX
;
; Read a directory block into DirectoryBuffer, writing out the current block
; first.
;
; Result:  CLC for success
;          SEC, A = error
;
FlushAndReadFirstDirectoryBlock:
   lda FirstDirectoryBlock+1
   ldx FirstDirectoryBlock
FlushAndReadDirectoryBlockAX:
   cmp DirectoryBlock+1
   bne @different
   cpx DirectoryBlock
   bne @different
   clc
   rts
@different:
   pha
   txa
   pha
   jsr WriteCurrentDirectoryBlock
   bcc @noError
   tax
   pla
   pla
   txa
   rts
@noError:
   pla
   tax
   pla
ReadDirectoryBlockAX:
   jsr   UseDirectoryBuffer
   sta   DirectoryBlock+1
   stx   DirectoryBlock
ReadBlockAX:
   sta   pdBlockNumberHigh
   stx   pdBlockNumberLow
DoReadBlock:
   lda   #PRODOS_READ
   sta   pdCommandCode
; Fall into CF block driver below.  If Block driver moves, place "jmp CFBlockDriver" here
;------------------------------------------------------------------------------
; Low Level CF Driver Entry point
;
; unit number not used currently
CFBlockDriver:
   bit CFFA1_Options
   bpl CFBlockDriverInternal
   jsr LogBlockOperationBefore
   jsr CFBlockDriverInternal
   jmp LogBlockOperationAfter

CFBlockDriverInternal:
 .if APPLE2
   jmp ReadOrWriteBlockAppleII
 .else
;
; Set CF card into 8bit mode
;
   lda  #Enable8BitTransfers
   sta  ATAFeature
   lda  #$00                         ; Drive=0              
   sta  ATA_LBA27_24                 ; Talk to the Master device and use LBA mode.
   lda  #ATASetFeature
   sta  ATACommand                   ;Issue the 8-bit feature command to the drive

; Don't wait here for CF card to be ready. Ready is check below already.
;;;;   jsr  IDEWaitReady                 ;Wait for BUSY flag to clear


; process the command code and jump to appropriate routine.

   lda  pdCommandCode
   cmp  #PRODOS_READ
   beq  ReadBlock

   cmp  #PRODOS_WRITE
   beq  WriteBlock

   cmp  #PRODOS_STATUS
   bne  @notStatus
   jmp  GetStatus
@notStatus:

   lda  #PRODOS_IO_ERROR
   sec
   rts

;------------------------------------------------------------------------------
; ReadBlock - Read a block from device into memory
;
; Input:
;       pd Command Block Data $42 - $47
;
; Output:
;       A = ProDOS read return code
;       Carry flag: 0 = Okay, 1 = Error
;
; ZeroPage Usage:
;       $F0
;       Note: location $F0 is saved and restored before driver exits
;
ReadBlock:

   lda  pdIOBufferHigh
   pha
   lda  zpt1
   pha

   jsr ReadBlockCore
   tax                              ; ver1.3: Save Acc

   pla
   sta  zpt1
   pla
   sta  pdIOBufferHigh
   txa                              ; ver1.3: restore Acc
   rts

ReadBlockCore:

   jsr  IDEWaitReady
   jsr  SetupTaskFile           ;Program the device's task file registers
                                ; based on ProDOS address

   lda  #ATACRead
   sta  ATACommand              ;Issue the read command to the drive
   jsr  IDEWaitReady            ;Wait for BUSY flag to clear

   lda  ATAStatus               ;Check for error response from device
   and  #$09
   cmp  #$01                    ;If DRQ=0 and ERR=1 a device error occured
   bne  rCommandOK

;
; The drive has returned an error code. Just return I/O error code to PRODOS
;
   lda  #PRODOS_IO_ERROR
   sec
   rts
;
; Sector is ready to read
;
rCommandOK:
   ldy  #2
   sty  zpt1
   ldy  #0

rLoop:
   lda  ATAStatus               ;Note: not using IDEWaitReady, using inline code
   bmi  rLoop                   ;Wait for BUSY (bit 7) to be zero
   and  #$08                    ;get DRQ status bit
   beq  rShort                  ;if off, didn't get enough data

   lda  ATAData
   sta  (pdIOBufferLow),y
   iny

   lda  ATAData
   sta  (pdIOBufferLow),y
   iny

   bne  rLoop
   inc  pdIOBufferHigh
   dec  zpt1
   bne  rLoop

   lda  #0
   clc
   rts
;
; The Block was short, return I/O error code to ProDOS
;
rShort:
   lda #PRODOS_IO_ERROR
   sec
   rts

;------------------------------------------------------------------------
; WriteBlock - Write a block in memory to device
;
; Input:
;       pd Command Block Data $42 - $47
;       X = requested slot number in form $n0 where n = slot 1 to 7
;
; Output:
;       A = ProDOS write return code
;       Carry flag: 0 = Okay, 1 = Error
;
WriteBlock:
   lda  pdIOBufferHigh
   pha
   lda  zpt1
   pha

   jsr  WriteBlockCore
   tax

   pla
   sta  zpt1
   pla
   sta  pdIOBufferHigh
   txa
   rts

WriteBlockCore:
   jsr  IDEWaitReady
   jsr  SetupTaskFile            ;program IDE task file

; Write sector from RAM
   lda  #ATACWrite
   sta  ATACommand
   jsr  IDEWaitReady

   lda  ATAStatus                ;Check for error response from writing command
   and  #$09
   cmp  #$01                     ;if DRQ=0 and ERR=1 an error occured
   bne  wCommandOK

; The drive has returned an error code. Just return I/O error code to PRODOS
;
   lda  #PRODOS_IO_ERROR
   sec
   rts
;
; Sector is ready to write
;
wCommandOK:
   ldy  #2
   sty  zpt1
   ldy  #0

wLoop:
   lda  ATAStatus               ;Note: not using IDEWaitReady, using inline code
   bmi  wLoop                   ;Wait for BUSY (bit 7) to be zero
   and  #$08                    ;get DRQ status bit
   beq  wShort                  ;if off, didn't get enough data

   bit  SetCSMask               ;Block all read cycles (esp the extra ones preceeding write cycles)

   lda  (pdIOBufferLow),y
   sta  ATAData
   iny
   lda  (pdIOBufferLow),y
   sta  ATAData

   bit  ClearCSMask             ;Set back to normal, allow CS0 assertions on read cycles

   iny
   bne  wLoop
   inc  pdIOBufferHigh
   dec  zpt1
   bne  wLoop

   lda  #0
   clc
   rts
;
; The Block was short, return I/O error code to PRODOS
;
wShort:
   lda  #PRODOS_IO_ERROR
   sec
   rts

;------------------------------------------------------------------------------
; SetupTaskFile - Program CF registers with block address to be accessed
; For now, no block number to LBA translation
;
SetupTaskFile:

   lda  pdBlockNumberLow
   sta  ATA_LBA07_00            ;store ProDOS Low block # into LBA 0-7

   lda  pdBlockNumberHigh
   sta  ATA_LBA15_08            ;store ProDOS High block # into LBA 15-8

   lda  #0
   sta  ATA_LBA23_16             ;store LBA bits 23-16

   lda  #$E0                    ; 1, (LBA), 1, (Drive), LBA 27-24, where LBA=1, Drive=0
   sta  ATA_LBA27_24                 ; Talk to the Master device and use LBA mode.

   lda  #1            
   sta  ATASectorCnt
   rts

;------------------------------------------------------------------------------
; GetStatus - Called by ProDOS and SmartPort to get device status and size
;
; Input:
;       DriveNumber (0 to 3)
;
; Output:
;       A = ProDOS status return code
;       X = drive size LSB
;       Y = drive size MSB
;       Carry flag: 0 = Okay, 1 = Error
;       DrvBlkCount0..DrvBlkCount2 = usable blocks on device
;
GetStatus:
;
; Determine if a drive/device is present.
;
   jsr  CheckDevice
   bcs  NoDrive

; Device is present
sDriveOK:
   jsr  IDEWaitReady
   lda  #ATAIdentify
   sta  ATACommand              ;Issue the read command to the drive
   jsr  IDEWaitReady            ;Wait for BUSY flag to go away

   lda  ATAStatus               ;Check for error response
   and  #$09
   cmp  #$01                    ;if DRQ=0 and ERR=1 an error occured
   bne  sValidATACommand

   lda  #PRODOS_IO_ERROR
   bne  sError                  ; Command Error occured, return error

sValidATACommand:
   ldy  #$00                    ;zero loop counter

sPrefetchloop:
   jsr  IDEWaitReady            ;See if a word is ready
   bcs  sWordRdy
   lda  #PRODOS_IO_ERROR
   bne  sError

sWordRdy:
   lda  ATAData                 ;Read words 0 thru 56 but throw them away
   iny
   cpy  #114   ;57 * 2          ;Number of the last byte you want to throw away
   bne  sPrefetchloop

sPrefetchDone:
   lda  ATAData                 ;Read the current capacity in sectors (LBA)
 .if BLOCKOFFSET<>0
   sec
   sbc  #BLOCKOFFSET
 .endif
   sta  DrvBlkCount0
   lda  ATAData
 .if BLOCKOFFSET<>0
   sbc  #0
 .endif
   sta  DrvBlkCount1
   lda  ATAData
 .if BLOCKOFFSET<>0
   sbc  #0
 .endif
   sta  DrvBlkCount2


   lda  DrvBlkCount2
   cmp  #PARTITIONS32MB         ;max out at (#PARTITIONS32MB * $10000 + 00FFFF)
                                ; blocks
   bcs  maxOutAtN

   lda  ATAData
   beq  lessThan8GB
maxOutAtN:
   lda  #$FF                    ;The device is truly huge! Just set our 3-byte
                                ; block count to $03FFFF
   sta  DrvBlkCount0
   sta  DrvBlkCount1
   lda  #PARTITIONS32MB-1       ;Number of 32MB devices, set by the equate:
                                ; #PARTITIONS32MB
   sta  DrvBlkCount2
lessThan8GB:


PostFetch:
   jsr IDEWaitReady             ;read the rest of the words, until command ends
   bcc sReadComplete
   lda ATAData
   jmp PostFetch
sReadComplete:

; DrvBlkCount2 is the number of 32 MB partitions availiable - 1,
; or the highest drive # supported (zero based).
;
; If DrvBlkCount2 > drive # then StatusSize = $FFFF
; If DrvBlkCount2 = drive # then StatusSize = DrvBlkCount1,DrvBlkCount0
; If DrvBlkCount2 < drive # then StatusSize = 0
;
; This scheme has a special case which must be handled because ProDOS
;   partitions are not quite 32 meg in size but are only FFFF blocks in size.
;   If a device is exactly: 32meg or 10000h blocks in size, it would appear
;   as one drive of size FFFF and another drive of size 0000. To handle this
;   case, we check for an exact size of 0000 and fall into the NoDrive code.
;
   lda DriveNumber
   cmp DrvBlkCount2
   beq ExactSize
   ldx #$FF
   ldy #$FF
   bcc sNoError               ; full size ($FFFF blocks)

NoDrive:
   lda  #PRODOS_OFFLINE
sError:
   ldx  #0
   ldy  #0
   sec
   rts

ExactSize:                    ;If equal, then DrvBlkCount1,DrvBlkCount0 is the
                              ; drive's exact size
   lda  DrvBlkCount0
   ora  DrvBlkCount1
   beq  NoDrive               ;can't have a 0-block device

   ldx  DrvBlkCount0
   ldy  DrvBlkCount1
sNoError:
   lda  #0
   clc                          ;no errors
   rts

;------------------------------------------------------------------------------
; IDEWaitReady - Waits for BUSY flag to clear, and returns DRQ bit status
;
; Input:
;       none
; Ouput:
;      Carry flag set if DRQ bit is on
;
; ZeroPage Usage:
;       None
;
; CPU Registers changed:  A, P
;
IDEWaitReady:
   lda  ATAStatus
   bmi  IDEWaitReady            ;Wait for BUSY (bit 7) to be zero
   ror                          ;shift DRQ status bit into the Carry bit
   ror
   ror
   ror
   rts

;------------------------------------------------------------------------------
; CheckDevice - Check to see if a device is attached to the interface.
;
; Input:
;       none
; Output:
;       Carry flag: 0 = Device Present, 1 = Device Missing
;
; CPU Registers changed:  A, P
;
;  Checks to see if the drive status register is readable and equal to $50
;  If so, return with the Carry clear, otherwise return with the carry set.
;  Waits up to 10sec on a standard 1MHz system for drive to become ready.
;
CheckDevice:
   tya
   pha
   bit  ClearCSMask             ;reset MASK bit in PLD for normal CS0 signaling
   lda  #$E0                    ;$E0 = [1, LBA, 1, Drive, LBA 27-24]  where
                                ; LBA=1, Drive=0
   sta  ATA_LBA27_24                 ;Make sure ATA master drive is accessed

   ldy  #0
chkLoop:
   lda  ATAStatus
   and  #%11010000
   cmp  #$50                    ;if BUSY= 0 and RDY=1 and DSC=1
   beq  DeviceFound
   lda  #WAIT_100ms
   jsr  Wait                    ;Wait 100ms for device to be ready
   iny
   cpy  #100                    ;Wait up to 10 seconds for drive to be ready
   bne chkLoop

   sec                          ;set c = 1 if drive is not attached
   bcs  DeviceExit

DeviceFound:
   clc                          ;set c = 0 if drive is attached

DeviceExit:
   pla
   tay
   rts
 .endif

;------------------------------------------------------------------------------
;  Wait - Copy of Apple's wait routine. Can't use ROM based routine in case
;         ROM is not active when we need it.
;
; Input:
;       A = desired delay time, where Delay(us) = .5(5A^2 + 27A + 26)
;       or more usefully: A = (Delay[in uS]/2.5 + 2.09)^.5 - 2.7
;
; CPU Registers changed:  A, P
;
Wait:
   sec

Wait2:
   pha

Wait3:
   sbc  #1
   bne  Wait3
   pla
   sbc  #1
   bne  Wait2
   rts


 .if APPLE2
;------------------------------------------------------------------------------
; ReadOrWriteBlockAppleII
;
; Input:  pdCommandCode, pdBlockNumber, pdIOBuffer
; Result: CLC for success, SEC/A=error
;
ReadOrWriteBlockAppleII:
   lda pdIOBufferHigh
   ldx pdIOBufferLow
   sta rw_buffer+1
   stx rw_buffer
   lda pdBlockNumberHigh
   ldx pdBlockNumberLow
   sta rw_block+1
   stx rw_block
   lda  pdCommandCode
   cmp  #PRODOS_READ
   beq  ReadBlockA2
   cmp  #PRODOS_WRITE
   beq  WriteBlockA2
   cmp  #PRODOS_STATUS
   beq  StatusA2
   lda  #PRODOS_IO_ERROR
   sec
   rts

ReadBlockA2:
   jsr $bf00
   .byte $80
   .word rw_parms
   rts

WriteBlockA2:
   jsr $bf00
   .byte $81
   .word rw_parms
   rts

rw_parms:
   .byte 3
   .byte $D0  ;slot 5, drive 2
rw_buffer:
   .word 0
rw_block:
   .word 0

StatusA2:
   lda DriveNumber
   cmp #2
   bcs @err
   cmp #1
   beq @status1
@status0:
   ldy #$12
   ldx #$34
   lda #0
   clc
   rts
@status1:
   ldy #$23
   ldx #$45
   lda #0
   clc
   rts
@err:
   lda #PRODOS_OFFLINE
   sec
   rts
 .endif

;------------------------------------------------------------------------------
; LogBlockOperationBefore
;
; Input:  pdCommandCode, pdIOBuffer, pdBlockNumber
; Result: Message displayed, such as:
;     [READ  $0002 @ $7A00
;     [WRITE $0006 @ $7E00
;     [STATUS $00
;
LogBlockOperationBefore:
   lda pdCommandCode
   cmp #PRODOS_READ
   beq @read
   cmp #PRODOS_WRITE
   beq @write
   cmp #PRODOS_STATUS
   beq @status
   jsr DispString
   .byte "[??? ",0
   rts
@read:
   jsr DispString
   .byte "[READ  ",0
   jmp @common
@write:
   jsr DispString
   .byte "[WRITE ",0
@common:
   lda pdBlockNumberHigh
   ldx pdBlockNumberLow
   jsr PrintHexAX
   jsr DispString
   .byte " @ ",0
   lda pdIOBufferHigh
   ldx pdIOBufferLow
   jmp PrintHexAX
@status:
   jsr DispString
   .byte "[STATUS ",0
   lda DriveNumber
   jmp DispByteWithDollarSign

;------------------------------------------------------------------------------
; LogBlockOperationAfter
;
; If CLC, just displays the "]",CR to end the log message.
; If SEC, displays the error code in A as well.
;
; Preserves:  A, P.
;
LogBlockOperationAfter:
   php
   pha
   bcc @noError
   jsr DispString
   .byte " ERR=$",0
   jsr DispByte
@noError:
   jsr DispString
   .byte "]",CR,0
   pla
   plp
   rts


;------------------------------------------------------------------------------
; At the end of the 8K of ROM, put our ID bytes and a version number.
;------------------------------------------------------------------------------
   .res Origin+$2000-32-4-*
   .byte $CF,$FA            ; $AFFC, $AFFD = ID bytes
   .byte OLDEST_COMPAT_VER  ; $AFFE = oldest API-compatible version
   .byte FIRMWARE_VER       ; $AFFF = version
;------------------------------------------------------------------------------
; END
;------------------------------------------------------------------------------

